COMMENT ⊗   VALID 00037 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	   -*-MIDAS-*-
C00007 00003	IFE QIO,[
C00009 00004		IFE QIO
C00011 00005		IFE QIO
C00013 00006		IFE QIO
C00016 00007	IFN QIO,[
C00020 00008	 CHECK LIST OF FILES IN AR1 FOR VALIDITY.
C00025 00009		IFN QIO
C00028 00010		IFN QIO
C00033 00011	TYOF3:	CAIN TT,33		ALTMODES ARE ALWAYS 1 WIDE
C00036 00012	TYOF4:				.SEE PTYO
C00040 00013	TERPRI AND PTYO FUNCTIONS
C00043 00014	PRINT, PRIN1, PRINC
C00046 00015	MAIN PRINTOUT ROUTINE
C00050 00016	IFN USELESS,[
C00053 00017	PRINT3:	PUSH P,A	MAIN RECURSIVE ENTRY FOR PRINTING
C00058 00018	PRINT A HUNK
C00060 00019	PRINT ATOM DISPATCH, AND PRINT AN ARRAY OR A RANDOM
C00063 00020	IFN QIO,[
C00067 00021	PRINT AN ATOMIC SYMBOL
C00070 00022	PRNN4:	CAIN F,1		A SIGN WITH NO FOLLOWING
C00072 00023	 COROUTINE TO DELIVER UP CHARACTERS OF A PRINT NAME.
C00074 00024	PRINT A FIXNUM
C00077 00025	PRI2B:	MOVM D,TT
C00080 00026	PRINT A FLONUM (SINGLE OR DOUBLE PRECISION)
C00085 00027		IFN DBFLAG
C00087 00028		IFN DBFLAG
C00090 00029	HERE ON FLONUMS < 0.01 (DB%) OR < 0.1 (DB$)
C00095 00030	PRINT A COMPLEX OR A DUPLEX
C00097 00031	IFN BIGNUM,[
C00099 00032	PRBFNA:	HLR A,B
C00101 00033	FLATSIZE, FLATC, EXPLODEC, EXPLODEN, EXPLODE
C00104 00034	EXPLODE: HRRZI R,EXPL1		SUBR 1
C00105 00035	BAKTRACE
C00109 00036	BKTR1A:	CAMGE A,@VBPORG		LETS HOPE THAT BPORG ISN'T SCREWED UP
C00112 00037	BKTR1B:	MOVE D,BKTRP
C00115 ENDMK
C⊗;
;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** PRINT AND FILE-HANDLING FUNCTIONS *******
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1978 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************


SUBTTL	FUNNY PRINTING ROUTINES

PGBOT PRT


IFE D10\QIO,[
RCPSBK:	SETZ
	SIXBIT \RCPOS\
	  1000,,TYIC
	402000,,D
]		;END OF IFE D10\QIO

.NOPOINT:
	PUSHJ P,NOTNOT
	HRRZM A,V.NOPOINT
	POPJ P,


COMMENT |	HERE IS A FINE HACK THAT GOT SUPERSEDED BY CTYP

CTY:	PUSHJ P,TYOI	;THIS IS ALWAYS DONE BY A XCT "Q,CTY - FOR RANDOM Q.
TYOI:	PUSH P,A	; USEFUL MAINLY BECAUSE IT SAVES A. WARNING!!!
	MOVE A,-1(P)	; THIS CODE IS VERY HACKISH, DEPENDENT ON THE OPCODE
	LDB A,[270600,,-1(A)]	; OF XCT (256). THIS ONLY WORKS FOR ASCII
	PUSHJ P,(R)	; CHARS IN THE RANGE 40-57. THUS Q MUST BE AMONG
	JRST POPAJ	;  [ !"#$%&'()*+,-./] (THE BRACKETS ARE META-CHARS!)

|		;END OF COMMENT


;;;	XCT N,CTYP
;;; CAUSES THE N'TH CHARACTER IN TYO1TB TO GET PRINTED VIA
;;; THE ROUTINE IN R.  SYMBOLS ARE DEFINED FOR THESE XCT'S.

CTYP:	PUSHJ P,TYO1C
TYO1C:	PUSH P,A
	HRRZ A,-1(P)
	LDB A,[270400,,-1(A)]
	MOVE A,TYO1TB(A)
	PUSHJ P,(R)
	JRST POPAJ

TYO1TB:
IRP X,,[#,(,),+,-,.,/,|,:,;, ,←,E,D,⊃,.]Z,,[NMBR,LPAR,RPAR,POS
NEG,DOT,SLSH,VBAR,CLN,SEMI,SPC,BAK,E,D,CTLQ,DCML]
%!Z!%=XCT .IRPCNT,CTYP
	"X
TERMIN
IFG .-TYO1TB-20, WARN [TOO MANY TYO1TB CHARACTERS]
IFE QIO,[

SUBTTL	OLD I/O TYO FUNCTION

%TYO:	JSP T,FXNV1
	MOVE A,TT
	ANDI A,177
	PUSH P,CTRUE
TYO:	JUMPL A,TYOLA
	CAIN A,15	;CLOBBERS D - - SAVES ALL OTHERS
	 JRST TYOCR
TYO2:	MOVE D,@VCHRCT
	SOJL D,TYTB1
	CAIN A,11	;TAB
	 JRST TYOTAB
TYO1:	ADDI D,IN0
	MOVEM D,VCHRCT
	CAIN A,"/
	JRST TYO1A
TYO1B:	SETZM LTYOC
TYO3:
IFN USELESS,[
	SKIPGE TYOSW	;TTY-ONLY CHARS DON'T GO TO FILES!
	JRST TYO7
]		;END OF IFN USELESS
IT$	SKIPLE LPTON
IT$	 PUSHJ P,LPTCHAR
	SKIPE TAPWRT
	 PUSHJ P,UTYO
IFN USELESS, TYO7: SKIPG TYOSW	;FILE-ONLY CHARS DON'T GO TO TTY!
	SKIPE TTYOFF
	 POPJ P,
	JRST TTYTYO

TYO1A:	AOS D,LTYOC
	SOJE D,TYO3
	JRST TYO1B

TYOLA:	MOVE D,@VCHRCT	;TYO LOOKAHEAD - RH OF A HAS DESIRED NUMBER OF
	CAIGE D,(A)	; CHARS FOR AN OBJECT ABOUT TO BE PRINTED
	 CAMN D,@VLINEL	;IF ALREADY AT BEGINNING OF LINE, CAN'T WIN ANY BETTER
	  POPJ P,
	PUSHJ P,ICR		;NEED TO OUTPUT A CR SO ATOM WILL FIT
	JFCL
	POPJ P,

STRTYO:	MOVE A,TT
	JRST TYO

;;;	IFE QIO

TYOCR:	MOVE D,@VLINEL		;LINEL HAD DAMNED WELL BETTER BE A FIXNUM,
	CAIGE D,XHINUM		; AND BETWEEN 8 AND HIGHEST NLISP INUM
	 CAIGE D,10
	  JSP D,LINELR
	JRST TYO1

TYOTAB:	SUB D,@VLINEL
	ORCMI D,7
	MOVEI D,11(D)
	SUB D,@VCHRCT
	MOVNS D
	JUMPG D,TYO1
	MOVEM A,LTYOC
	MOVEI D,IN0
	MOVEM D,VCHRCT
TYTB1:	PUSHJ P,ICR
	 JRST TYO1B
	JRST TYO2

;;;	SKIPS IF THE TERPRI IS ACTUALLY DONE.  NO SKIP IF SUPPRESSSED

ICR:	SKIPE V%TERPRI
	 POPJ P,
	MOVE D,@VLINEL		;LINEL HAD DAMNED WELL BETTER BE A FIXNUM,
	CAIGE D,XHINUM		; AND BETWEEN 8 AND HIGHEST NLISP INUM
	 CAIGE D,10
	  JSP D,LINELR
	PUSH FXP,TT
	MOVEI TT,LRCT-1
	MOVE D,VREADTABLE
	HLRZ TT,@TTSAR(D)
	IOR TT,LTYOC
	JUMPN TT,RSTX1
	POP FXP,TT
	AOS (P)
	JRST ITERPRI


;;;	IFE QIO

IFN ITS,[
LPTCHAR:	SKIPN LPTOPD
	PUSHJ P,LPTOPN
	PUSH P,[.IOT LPTC,A]
	JRST CHARCOM
	OPNGEN LPT,1
]		;END OF IFN ITS

UTYO:	PUSH P,[PUSHJ P,UTTYO]	;OUTPUT TO UTAPE [OR OTHER AUXILLARY DEVICE]
CHARCOM:	XCT (P)
	CAIE A,15
	JRST POP1J
	MOVEI A,12
	XCT (P)
	MOVEI A,15
	JRST POP1J

UTOER2:	SETOM UTOBYT
	UNLOCKI
	PUSH P,[UTOER3]
	PUSH P,A
	PUSH P,CPOPAJ
	JRST UTOER1
UTOER3:	SKIPG UTOBYT
	JRST UTOER4
	MOVEI D,TRUTH
	MOVEM D,TAPWRT
UTTYO:	SOSGE UTOBYT
	JRST .+3
	IDPB A,UTOBP
	POPJ P,
	LOCKI
	SKIPL UTOBYT	;INTERVENING INTERRUPT BETWEEN SOSGE AND LOCKI
	.VALUE
	SKIPN UTOOPD
	JRST UTOER2
IT$	MOVE D,[-UTBSIZ,,UTOB]
IT$	.IOT UTOC,D
10$	OUT UTOC,
10$	JRST UTTYO2
10$ D10WF:	LERR [SIXBIT \OUTPUT FAILURE!\]
IT$	PUSHJ P,UTOINT
UTTYO2:	UNLOCKI
	JRST UTTYO

UTOER4:	MOVSI D,(JFCL)	;CONVERT PUSHJ P,UTTYO ON PDL INTO
	MOVEM D,-1(P)	;HARMLESS JFCL, JUST IN CASE THERE IS CR-LF
	POPJ P,

IFN ITS,[
UTOINT:	MOVE D,UTOIBP
	MOVEM D,UTOBP
	MOVEI D,UTBSIZ*BYTSWD
	MOVEM D,UTOBYT
	POPJ P,
UTOIBP:	440700,,UTOB
]		;END OF IFN ITS
;;;	IFE QIO

TTYTYO:
IFN D10,[
SA%	CAIN A,33	;DEC LOSES ALT MODES
SA%	JRST OUT$
	OUTCHR A		;SO OUTPUT CHARACTER
	CAIN A,↑M		;IF IT WAS A CR,
	OUTCHR .+1		; OUTPUT A LF ALSO
	POPJ P,↑J		;MIGHT AS WELL HIDE THE LF IN A POPJ
]		;END OF IFN D10
IFN ITS,[
	CAIN A,↑P		;ITS LOSES ON CTRL/P
	JRST TYOCP
	.IOT TYOC,A
TTYTY1:	SKIPE SPP
	CAIE A,↑M
	POPJ P,
	SKIPN SRNLN1
	POPJ P,
	.CALL RCPSBK	;AFTER TYOING A CR, AND BEING IN DISPLAY PAUSE MODE
	.VALUE		;READ CURSOR POSITION TO SEE IF WE SHOULD PAUSE
	HLRZS D
	CAMGE D,SRNLN1
	POPJ P,
	MOVEI D,[ASCIZ \⊂S--PAUSE-- HIT ↑U TO CONTINUE\]
	SETZM PAUSFL
	PUSHJ P,SRNTYP
	SKIPN PAUSFL
	.HANG
	MOVEI D,PAUSCLR
SRNTYP:	HRLI D,440700	;OUTPUT STRING OF CHARS TO TTY
	PUSH FXP,D	;USES ONLY D, WHICH POINTS TO CHARS
SNTP0:	ILDB D,(FXP)	;MUST SAVE AR2A AND R, EITHER OF
	JUMPE D,PX1J	; WHICH MAY CONTAIN THE CHARS!
	CAIN D,↑P	;MUST BE VERY CIRCUMSPECT ABOUT ↑P
	JRST SNTP1	; - INTERRUPTING BETWEEN ↑P AND NEXT
	.IOT TYOC,D	; CHAR(S) COULD CAUSE AN I/O SCREW
	JRST SNTP0
SNTP1:	HLLOS NOQUIT	;SO TURN ON NOQUIT
	.IOT TYOC,D	;OUTPUT THE ↑P
	ILDB D,(FXP)
	.IOT TYOC,D	;OUTPUT NEXT CHAR
	CAIE D,"H	;IF WAS H OR V, ↑P EXPECTS YET
	CAIN D,"V	; ANOTHER CHAR
	JRST SNTP2
SNTP3:	HLLZS NOQUIT	;SO RELEASE NOQUIT
	SKIPE INTFLG	;MAYBE CHECK FOR INTERRUPTS
	PUSHJ P,CHECKI
	JRST SNTP0

SNTP2:	ILDB D,(FXP)	;HANDLE CASE OF  ↑P H  OR  ↑P V
	.IOT TYOC,D
	JRST SNTP3

TYOCP:	PUSHJ P,ECOCNP
	JRST TTYTY1

PAUSCLR:	ASCIB [⊂R⊂)
]
]		;END OF IFN ITS

]		;END OF IFE QIO
IFN QIO,[

SUBTTL	NEWIO TYO FUNCTION AND RELATED ROUTINES

;;; CALLED BY FUNCTIONS LIKE PRINT WHICH TAKE AN ARG AND
;;; AN OPTIONAL ASCII OUTPUT FILE ARRAY. DOES ARGS CHECKING
;;; AND SETS UP AR1 WITH THE CORRECT OUTPUT FILE(S).
;;; IF ONE ARG IS GIVEN AND THERE ARE NO FILES TO OUTPUT TO
;;; (↑W IS NON-NIL, AND EITHER ↑R OR OUTFILES IS NIL),
;;; THEN A POPJ IS DONE, RETURNING FOR THE CALLING FUNCTION.
;;; LEFT HALF BITS IN AR1:
;;;	400000	RH OF AR1 HAS SINGLE FILE ARRAY (ELSE LIST)
;;;	200000	DO *NOT* OUTPUT TO TTY AS WELL
;;;		IFN SFA, THEN ALSO PRINT/PRINC/PRIN1/TYO BIT
;;;
;;; CALLED BY:
;;;		JSP F,PRNARG
;;;		   XXX,,[QPRINT]	;ATOM FOR WNA ERROR
;;;	-OR-	   XXX,,[<SFA-BIT>,,QPRINT] ;IFN SFA
;;; XXX IS TYPICALLY JFCL.  IF XXX IS NEGATIVE, THE RETURN VALUE
;;; FOR THE FUNCTION IS NIL INSTEAD OF T.

PRNARG:	AOJN T,PRNAR2
	POP P,A
PRNAR$:	SAVE AR1 AR2A CPNAGX
PRNAR0:	SKIPE AR1,TAPWRT	;IF ↑R NOT SET, USE NIL
	 HRRZ AR1,VOUTFILES	;OTHERWISE USE OUTFILES
	JUMPN AR1,PRNAR3
	SKIPE TTYOFF
	 JRST PRNAR8
PRNAR3:
SFA$	HLRZ T,@(F)		;PLACE OPERATIONS FLAG IN AR1
SFA$	TLO AR1,(T)
	TRNN AR1,-1
SFA$	 JRST PRNTTY		;GOING TO THE TTY
SFA%	 JRST 1(F)
	PUSHJ P,MPFLOK
	 JRST 1(F)
PRNAR7:	PUSHJ P,OFCAN
	EXCH A,AR1
	PUSHJ P,[IOL [LOSING OUTPUT FILE SPECS!]]
	EXCH A,AR1
	JUMPE T,PRNAR0
	JRST PRNAR4

IFN SFA,[
PRNTTY:	TLNE AR1,200000		;REALLY GOING TO THE TTY?
	 JRST 1(F)		;NOPE, SO RETURN
	MOVSI T,AS.SFA		;IS C(TYO) AN SFA?
	MOVE R,V%TYO
	TDNN T,ASAR(R)
	 JRST 1(F)		;NOPE, SO ALL IS OK
	HLLZ T,@(F)		;SFA OPERATION MASK
	MOVEI TT,SR.WOM
	TDNN T,@TTSAR(R)	;CAN THE SFA DO THIS OPERATION DIRECTLY?
	 JRST 1(F)		;NOPE, IT WILL HANDLER A LOWER-LEVEL THING
	MOVEI C,(A)		;ARG IS THING TO PRINT/PRINC/PRIN1
	MOVEI AR1,(R)		;THE SFA
	JRST ISTCAL		;DO AN INTERNAL SFA CALL
]		;END IFN SFA

PRNAR2:	CAME T,XC-1
	 JRST PRNAR9
	MOVE A,-1(P)
	MOVEM AR1,-1(P)
	EXCH AR2A,(P)
	PUSH P,CPNAGX
	SKIPN AR1,AR2A
	 AOJA T,PRNAR0
PRNAR4:	JSP T,PRNARK
	 JRST PRNARA		;ERRONEOUS FILE
	 JRST PRNAR6		;LIST OF SOME KIND
SFA$	 SKIPA			;NORMAL RETURN
SFA$	 JRST PRNAR8		;HANDLED THE SFA
PRNAR5:	TLO AR1,600000		;VALID FILE OBJECT
	HLRZ T,@(F)
	TLO AR1,(T)
	JRST 1(F)

PRNAR6:	TLO AR1,200000
	JRST PRNAR3

PRNARA:	TLO AR1,200000		;MAKE ERROR MESSAGE PRINT CORRECTLY
	JRST PRNAR7

PRNAR8:	SKIPGE (F)
	 JRST FALSE
	JRST TRUE

PRNAR9:	HRRZ D,@(F)
	JRST S1WNAL

PNAGX:	RSTR AR2A AR1
CPNAGX:	POPJ P,PNAGX
;;; CHECK LIST OF FILES IN AR1 FOR VALIDITY.
;;; SKIPS ON *FAILURE*.

MPFLOK:	PUSH P,AR1		;MUST PRESERVE LH OF AR1
	MOVEI AR2A,(AR1)
MPFLO1:	JUMPE AR2A,MPFLO2
	HLRZ AR1,(AR2A)
	JSP T,PRNARK
	 JRST MPFLO3		;ERROR
	 JRST MPFLO3		;LIST (NOT ALLOWED WITHIN ANOTHER LIST)
SFA$	 SKIPA			;NORMAL
SFA$	 JFCL			;HANDLED THE SFA
	HRRZ AR2A,(AR2A)
	JRST MPFLO1

MPFLO3:	AOS -1(P)		;ERROR - SKIP
MPFLO2:	POP P,AR1
	POPJ P,

;;; CHECK OUT OBJECT IN AR1.
;;;	SKIP 3 IF AN SFA, AND HANDLED IT
;;;	SKIP 2 IF A VALID, OPEN, NON-BINARY, OUTPUT FILE OBJECT.
;;;	SKIP 1 IF A LIST (ELEMENTS ARE NOT CHECKED).
;;;	SKIP 0 OTHERWISE.

PRNARK:	CAIN AR1,TRUTH		;ARG CHECK FOR PRNARG
	 HRRZ AR1,V%TYO		;FOR T, ASSUME CONTENTS OF TYO
	JSP TT,XFOSP		;MUST BE FILE ARRAY OR SFA
	 JRST PRNRK2
IFN SFA,[
	  JRST PRNRK1
	PUSH P,T		;SAVE T
	MOVEI TT,SR.WOM		;AN SFA
	HLLZ T,@(F)		;THE APPROPRIATE FUNCTION
	TDNN T,@TTSAR(AR1)	;CAN THE SFA DO IT?
	 JRST PRNRK3		;NOPE, RESTORE T AND PROCEED
	PUSHJ FXP,SAV5		;SAVE THE 'WORLD'
	PUSHJ P,SAVX5
	MOVEI C,(A)		;ARGUMENT TO SFA
	PUSHJ P,ISTCAL
	PUSHJ P,RSTX5
	PUSHJ FXP,RST5
	POP P,T
	JRST 3(T)		;TRIPLE-SKIP RETURN
PRNRK3:	POP P,T
	JRST 2(T)		;DOUBLE-SKIP RETURN, LOWER-LEVEL WILL HANDLE IT
PRNRK1:	]	;END IFN SFA
	MOVE TT,TTSAR(AR1)
	TLNE TT,TTS.IO		;MUST BE OUTPUT FILE
	 TLNE TT,TTS<BN+CL>	;MUST NOT BE CLOSED, NOR BINARY
	  JRST (T)		;ERROR
	JRST 2(T)		;SUCCESS - VALID FILE OBJECT

PRNRK2:	MOVEI TT,(AR1)
	LSH TT,-SEGLOG
	SKIPGE ST(TT)
	 JRST 1(T)		;OKAY IF LIST (CALLER USUALLY WILL USE MPFLOK)
	JRST (T)		;ELSE ERROR

IFN SFA,[
;;; FILE-ARRAY OR LIST IN AR1: IF ZERO USE V%TYO
PRTSTO:	PUSH P,PRTSO1		;IN CASE PRTSTR POPJS
	PUSH FXP,F
	PUSH FXP,A
	MOVEI A,(FXP)		;GIVE IT A PDL NUMBER
	JSP F,PRTSTR		;DO SFA CHECKING
	[SO.TYO,,]
	POP FXP,A
	POPI P,1
PRTSO1:	POPJ FXP,.+1		;RETURN TO CALLER
	POPI FXP,2		;HANDLED ALL WE NEEDED TO
	POPJ P,

PRTSTR:	JUMPE AR1,PRTST1	;HANDLE DEFAULT CONDITION SPECIALLY
	JSP T,PRNARK		;CHECK OUT C(AR1)
	 JFCL			;PROBABLY BAD OUTFILES
	 JRST PRTSTL		;A LIST
	 JRST 1(F)		;A FILE ARRAY OR UNHANDLED SFA
	 POPJ P,		;A HANDLED SFA

PRTST1:	HRRZ AR1,V%TYO
	MOVEI TT,SR.WOM		;AN SFA
	HLLZ T,@(F)		;THE APPROPRIATE FUNCTION
	TDNN T,@TTSAR(AR1)	;CAN THE SFA DO IT?
	 JRST PRTST2		;NOPE, RETURN NORMALLY
	PUSHJ FXP,SAV5		;SAVE THE 'WORLD'
	PUSHJ P,SAVX5
	MOVEI C,(A)		;ARGUMENT TO SFA
	PUSHJ P,ISTCAL
	PUSHJ P,RSTX5
	PUSHJ FXP,RST5
	POPJ P,			;RETURN
PRTST2:	SETZ AR1,		;MAKE SURE AR1 IS STILL ZERO
	JRST 1(F)		;THEN RETURN TO CALLER

PRTSTL:	PUSHJ P,MPFLOK		;CHECK THE LIST IN AR1
	 JRST 1(F)		;RETURN IF ALL OK
	PUSHJ P,OFCAN
	EXCH A,AR1
	PUSHJ P,[IOL [LOSING OUTPUT FILE SPECS!]]
	EXCH A,AR1
	JRST PRTSTR
]		;END IFN SFA
;;;	IFN QIO

TYO$:	JSP F,PRNAR$			;USER'S "*TYO" ENTRY
SFA$		[SO.TYO,,QTYO$]
SFA%		[QTYO$]
	JRST %TYO1

%TYO:	JSP F,PRNARG			;USER'S "TYO" ENTRY
SFA%	 JFCL [Q%TYO]
SFA$	 JFCL [SO.TYO,,Q%TYO]
%TYO1:	JSP T,GTRDTB
	PUSHJ P,TYO1
	JRST TRUE

TYO:	SKIPE AR1,TAPWRT		;ENTRY FOR SINGLE-ENTER INTERNALS
	 HRRZ AR1,VOUTFILES		;TEMP ??
SFA$	JSP F,PRTSTO			;DO SFA CHECKING STUFF

$TYO:	PUSH FXP,T			;ENTRY FOR PRIN1, PRINC, GC-PRINTOUT,
	PUSH FXP,TT			;  AND MULTIPLE-ENTER INTERNALS
	PUSH P,[PXTTTJ]	
	JSP T,GTRDTB
TYOPR:	SKIPA TT,A			;MUST SAVE R FOR PRINT
TYO1:	 JSP F,TYOARG
;AT THIS POINT: CHAR IN TT, FILE(S) IN AR1, READTABLE IN AR2A
;MUST SAVE A,B,C,AR1,R
TYO6:	.5LKTOPOPJ
STRTYO:	JUMPGE AR1,TYO5
	TLNN AR1,200000
	 SKIPE TTYOFF
	  JRST TYO6A
	SKIPLE TYOSW
	 JRST TYO6A
	PUSH P,AR1
	HRR AR1,V%TYO
	TLZ AR1,600000	
	PUSHJ P,TYOF
	POP P,AR1
TYO6A:	MOVEI T,(AR1)
	CAIE T,TRUTH
	 JRST TYO6B
	HRR AR1,V%TYO		;T MEANS SAME AS VALUE OF TYO,
	SKIPN TTYOFF		; BUT CAN BE SILENCED BY ↑W
TYO6B:	 SKIPGE TYOSW
	  POPJ P,
	JRST TYOF

TYO5:
REPEAT 2, PUSH P,AR1
	HRRZS -1(P)
	TLNN AR1,200000
	 SKIPE TTYOFF
	  JRST TYO2
	HRR AR1,V%TYO
	SKIPG TYOSW
	 PUSHJ P,TYOF
TYO2:	SKIPL TYOSW
TYO2A:  SKIPN AR1,-1(P)
	  JRST TYO4
	HLRZ AR1,(AR1)
	CAIN AR1,TRUTH
	 JRST TYO2Z
	HLL AR1,(P)
	JRST TYO2B
TYO2Z:	HRRZ AR1,V%TYO
	HLL AR1,(P)
	SKIPN TTYOFF
TYO2B:	 PUSHJ P,TYOF
	HRRZ AR1,@-1(P)
	MOVEM AR1,-1(P)
	JRST TYO2A

TYO4:	POP P,AR1		;PRESERVE AR1
	JRST POP1J

TYOARG:	JSP T,FXNV1
IFN SAIL\ITS, TDNN TT,[777777,,770000]	;UP TO 12. BITS OKAY
IFE SAIL\ITS, TDNN TT,[777777,,777400]	;UP TO 8 BITS OKAY
	 JRST (F)
	JRST TYOAGE
;;;	IFN QIO

;;; TYO ONE CHARACTER TO ONE FILE.  MUST PRESERVE AR1,AR2A
;;;	USER INTERRUPTS LOCKED OUT. (??)
;;;	FILE ARRAY IN AR1.
;;;	READTABLE IN AR2A.
;;;	CHARACTER IN TT (MUST BE PRESERVED).
;;; TYOF HANDLES ALL CHARPOS, LINENUM, AND PAGENUM PROCESSING,
;;; CONTROL CHARACTERS, SAIL MODE OUTPUT, ETC.
;;; ALL CR'S NOT FOLLOWED BY LF'S HAVE LF'S SUPPLIED FOR THEM.
;;; MUST SAVE R FOR PRINT.

TYOFA:	MOVE TT,A
TYOFIL:	.5LKTOPOPJ
TYOF:	TRNN AR1,-1
	 JRST TYOFE
IFN SFA,[
	MOVSI T,AS.SFA		;AN SFA?
	TDNN T,ASAR(AR1)
	 JRST TYOFS0		;NOPE
	PUSHJ FXP,SAV5		;SAVE THE 'WORLD'
	PUSHJ P,SAVX5
	SKIPGE TT		   ;DO A CONVERSION ON FORMAT INFO
	 MOVNI TT,(TT)
	JSP T,FXCONS		;CONS UP A FIXNUM
	HLLZ T,AR1		;HAS THIS SFA BEEN HACKED AT A HIGHER LEVEL?
	TLZ T,600000		;BITS NOT OF INTEREST TO THE SFA
	MOVEI TT,SR.WOM
	TDNE T,@TTSAR(AR1)	;CHECK THE OPERATIONS MASK
	 JRST TYOFS1		;ALRADY DONE IT, SO RETURN
	HRRZS INHIBI		;REALLY DIDN'T WANT THAT .5LKTOPOPJ
	MOVEI C,(A)		;AS THE ARGUMENT TO THE SFA
	MOVEI B,Q%TYO		;A TYO OPERATION
	MOVEI A,(AR1)		;THE SFA ITSELF
	PUSHJ P,ISTCSH		;DO SHORT INTERNAL SFA CALL
TYOFS1:	PUSHJ FXP,RST5
	JRST RSTX5		;RESTORE ACS AND RETURN
TYOFS0:	]	;END IFN SFA
	MOVE T,TTSAR(AR1)
	JUMPL TT,TYOF7		;NEGATIVE => FORMAT INFO
	SKIPGE ATO.LC(T)
	 PUSHJ P,TYOFXL
IT%	CAIN TT,177		;RUBOUT HAS NO PRINT WIDTH
IT%	 JRST TYOF4
	CAIN TT,7		;<BELL> HAS NO PRINT WIDTH
	 JRST TYOF0G
IT$	CAIE TT,177		;ITS RUBOUT PRINTS AS TWO CHARACTERS
	 CAIGE TT,40		;CONTROL CHARACTERS HAVE WIDTH
	  JRST TYOF2		; OF 1 OR 2, OR ELSE ARE FUNNY
TYOF0D:	AOS D,AT.CHS(T)		;INCREMENT CHARPOS
	SKIPE ATO.LC(T)		;SKIP UNLESS LAST CHAR WAS /
	 JRST TYOF0G
	SKIPLE FO.LNL(T)	;ZERO OR NEGATIVE LINEL => INFINITY
	 TLNE T,TTS<IM>		.SEE STERPRI
	  JRST TYOF0E		;FOR IMAGE OUTPUT, NO EXTRA CHARS
	CAMLE D,FO.LNL(T)
	 SKIPE V%TERPRI
	  JRST TYOF0E
	HRLM TT,(P)		;NEW LINE NEEDED BEFORE THIS CHAR
	MOVEI TT,↑M		;BECAUSE OF AUTO-TERPRI
	PUSHJ P,TYOF4
	PUSHJ P,TYOFXL
	MOVEI TT,1
	MOVEM TT,AT.CHS(T)		;SO THIS CHAR WILL BE AT CHARPOS 1
	HLRZ TT,(P)
TYOF0E:	MOVE D,@TTSAR(AR2A)		;GET READTABLE ENTRY FOR THIS
	TLNE D,2000	.SEE SYNTAX	;IF THIS IS A /, SET FLAG
	 HLLOS ATO.LC(T)		; FOR NEXT TIME AROUND
	JRST TYOF4

TYOF0G:	SETZM ATO.LC(T)		;RESET / FLAG
	JRST TYOF4		;OUTPUT CHAR, IGNORING LINEL

TYOF2:	CAIG TT,↑M		;FOUND CONTROL CHAR
	 CAIGE TT,↑H
	  JRST TYOF3		;REGULAR CONTROL CHAR
	JRST @.+1-↑H(TT)	;FORMAT EFFECTOR - PECULIAR
		TYOFBS		;↑H	BACKSPACE
		TYOFTB		;↑I	TAB
		TYOFLF		;↑J	LINE FEED
		TYOF3		;↑K	<NOT REALLY FORMAT CHAR>
		TYOFFF		;↑L	FORM FEED
		TYOFCR		;↑M	CARRIAGE RETURN

TYOFXL:	SETZM ATO.LC(T)		;LINE FEED NEEDED BEFORE THIS CHAR
	CAIE TT,↑J		;FORGET IT IF THIS CHAR IS LF
	 TLNE T,TTS<IM>		;DON'T GENERATE LF FOR IMAGE FILE
	  POPJ P,
	HRLM TT,(P)
	MOVEI TT,↑J
	PUSHJ P,TYOFLF
	HLRZ TT,(P)
	POPJ P,

TYOFE:	EXCH A,AR1
	%WTA [SIXBIT \NOT A FILE - TYO!\]

TYOF3:	CAIN TT,33		;ALTMODES ARE ALWAYS 1 WIDE
	 JRST TYOF0D
	MOVE D,F.MODE(T)	;RANDOM CONTROL CHAR
IFE SAIL,[
IT$	CAIE TT,177		;RUBOUT PRINTS TWO POSITIONS EVEN IN SAIL MODE
	 TLNN D,FBT<SA>		;SKIP IF SAIL MODE FILE
	  AOS AT.CHS(T)		;OTHERWISE CONTROL CHARS ARE 2 WIDE
]	;END OF IFE SAIL
	JRST TYOF0D

TYOFBS:	SKIPLE AT.CHS(T)	;BACKSPACE - UNLESS AGAINST LEFT MARGIN,
	 SOS AT.CHS(T)		; DECREMENT CHARPOS
	SETZM ATO.LC(T)		;CLEAR / FLAG
	JRST TYOF4

TYOFTB:	MOVEI D,7		;TAB FOUND - JUMP TO NEXT
	IORM D,AT.CHS(T)	;MULTIPLE-OF-8 CHARPOS
	JRST TYOF0D

TYOFLF:	AOS D,AT.LNN(T)		;INCREMENT LINENUM
	SKIPLE FO.PGL(T)	;ZERO PAGEL => INFINITY
	 CAMGE D,FO.PGL(T)	;SKIP IF OVER PAGE LENGTH
	  JRST TYOF4
TYOFFF:	SETZM AT.LNN(T)		;ZERO LINE NUMBER
	AOS AT.PGN(T)		;INCREMENT PAGE NUMBER
	TLNN T,TTS.TY		;IF TTY THEN DON'T GIVE END PAGE INT ON ↑L
	 SKIPN FO.EOP(T)	;IF IT HAS AN ENDPAGEFN, THEN
	  JRST TYOF4		; WANT TO GIVE USER INTERRUPT
	PUSHJ P,TYOF4
	MOVEI D,200000+2*FO.EOP+1
	HRLI D,(AR1)
	JRST UINT

TYOF7:	SKIPLE FO.LNL(T)	;INFINITE LINEL
	 TLNE T,TTS<IM>		; OR IMAGE MODE TTY
	  POPJ P,		; => IGNORE FORMAT DATA
	SKIPN V%TERPRI
	SKIPN AT.CHS(T)		;CAN'T DO ANY BETTER THAN TO BE
	 POPJ P,		; AT THE BEGINNING OF A LINE
	MOVEI D,(TT)
	ADD D,AT.CHS(T)
	CAMG D,FO.LNL(T)
	 POPJ P,
	SETZM AT.CHS(T)
	PUSH FXP,TT
	MOVEI TT,↑M		;IF TOO LONG, DO AN AUTO-TERPRI
	PUSHJ P,TYOFCR
	POP FXP,TT
	POPJ P,

TYOFCR:	SETZM AT.CHS(T)		;CR - SET CHARPOS TO ZERO
	PUSHJ P,TYOF4
	SETOM ATO.LC(T)		;SET LF FLAG (MUSTN'T DO UNTIL AFTER IOT
	POPJ P,			; OF CR BECAUSE A **MORE** MIGHT OCCUR)
TYOF4:				.SEE PTYO
IT$	TLNE T,TTS.TY
IT$	 JRST TYOF4C
TYOF6:
TYOF4A:	SKIPL F.MODE(T)		.SEE FBT.CM
	 JRST TYOF5
IFN ITS,[
	MOVE D,F.CHAN(T)	;CHARMODE (UNIT MODE)
	LSH D,27		;TYI USES THIS CODE TOO (SAVES F)
	IOR D,[.IOT TT]
   SPECPRO INTTYX
TYOXCT:	XCT D
   NOPRO
]		;END OF IFN ITS
IFN D10,[
SA$	 OUTCHR TT
IFE SAIL,[
	TLNN T,TTS.TY
	 JRST .+3
	  IONEOU TT
	  JRST .+5
	CAIE TT,33		;NON-SAIL MONITORS LOSE ALTMODES
	 OUTCHR TT
	CAIN TT,33		;FOR THEM, WE OUTPUT ALTMODE AS $
	 OUTCHR C$		; (ON THE TTY ONLY!)
]		;END OF IFE SAIL
]		;END OF IFN D10
IFN D20,[
	PUSHJ FXP,SAV2
	HRRZ 1,F.JFN(T)
	MOVEI 2,(TT)
	BOUT			;OUTPUT THE BYTE
	PUSHJ FXP,RST2
]		;END OF IFN D20
	AOS F.FPOS(T)		;ADJUST FILE POSITION (DOESN'T HURT IF F.FLEN NEG)
C$:	POPJ P,"$

INTTYR:	HRROS INHIBIT		.SEE $IWAIT	;COME HERE AFTER INTERRUPT
	MOVE T,TTSAR(AR1)	;FILE ARRAY MAY HAVE MOVED
	POPJ P,			.SEE TYIXCT TYICAL

TYOF5:				;BLOCK MODE
IFN ITS+D20,[
	IDPB TT,FB.BP(T)	;PUT BYTE IN BUFFER
	SOSLE FB.CNT(T)		;DECREMENT COUNT
]		;END OF IFN ITS+D20
IFN D10,[
	MOVE D,FB.HED(T)	;FOR D10, BYTE POINTER AND COUNT ARE IN BUFFER HEADER
	IDPB TT,1(D)		;PUT BYTE IN BUFFER
	SOSLE 2(D)		;DECREMENT COUNT
]		;END OF IFN D10
	 POPJ P,
	HRLM TT,(P)
	MOVE TT,T
	PUSH FXP,F
	PUSHJ P,IFORCE
	POP FXP,F
	HLRZ TT,(P)
TYOF5Y:	MOVE T,TTSAR(AR1)
	POPJ P,

IFN ITS,[
TYOF4C:	TLNN T,TTS.IM		;DO NOT HACK THIS FOR IMAGE MODE
	 CAIE TT,↑P		;↑P IS THE DISPLAY ESCAPE CODE, AND
	  JRST TYOF4A		; MUST BE TREATED SPECIALLY
	SKIPGE F.MODE(T)	.SEE FBT.CM
	 JRST TYOF4J
	MOVE TT,FB.CNT(T)	;FOR BLOCK MODE, BE CAREFUL
	PUSH FXP,F
	CAIGE T,2		; ABOUT SPLITTING A ↑P-CODE
	 PUSHJ P,IFORCE		; ACROSS A BLOCK BOUNDARY
	POP FXP,F
TYOF4J:	MOVE T,TTSAR(AR1)	;OUTPUT ↑P AS ↑P P
	MOVEI TT,↑P
	PUSHJ P,TYOF4A
	MOVE T,TTSAR(AR1)
	MOVEI TT,"P
	PUSHJ P,TYOF4A
	JRST TYOF5Y
]		;END OF IFN ITS

]		;END OF IFN QIO
SUBTTL	TERPRI AND PTYO FUNCTIONS

IFE QIO,[
%TERPRI:
TERPRI:	MOVEI A,NIL		;SUBR 0
ITERPRI:
	PUSH P,A
	MOVEI A,↑M
	PUSHJ P,TYO
	JRST POPAJ
]		;END OF IFE QIO


IFN QIO,[
%TERPRI:
	JUMPN T,.+3
	PUSH P,R70
	MOVNI T,1
	PUSH P,(P)		;EVEN THOUGH LSUBR (0 . 1)
	SOS T			;PRETEND TO BE (1 . 2) FOR PRNARG'S SAKE
	JSP F,PRNARG		;PRNARG MAY DO A POPJ FOR US - BEWARE!
SFA%	   400000,,[Q%TERPRI]	;BIT 4.9 => RETURN VALUE IS NIL
SFA$	   400000,,[SO.TRP,,Q%TERPRI]	;BIT 4.9 => RETURN VALUE IS NIL
	JRST TERP1

TRP$:	JSP F,PRNAR$
SFA%	   400000,,[QTRP$]
SFA$	   400000,,[SO.TRP,,QTRP$]
	JRST TERP1

TERPRI:	SKIPE AR1,TAPWRT	;1/4-INTERNAL TERPRI
	 HRRZ AR1,VOUTFILES
SFA$	JSP F,PRTSTR		;DO SFA CHECKING STUFF
SFA$	[SO.TRP,,]
TERP1:	JSP T,GTRDTB		;SEMI-INTERNAL TERPRI
	MOVEI A,NIL
ITERPRI:
	PUSH P,A		;INTERNAL TERPRI - SAVES A,B,C
	MOVEI TT,↑M		;MUST HAVE FILE ARRAY IN AR1,
	PUSHJ P,TYO6		; READTABLE IN AR2A
	MOVEI TT,↑J
	PUSHJ P,TYO6
	JRST POPAJ

PTYO:	SKIPE V.RSET		; +TYO: SUBR 2
	 JRST PTYO2
PTYO1:	MOVE TT,(A)		;FIRST ARG IS ASCII VALUE
	CAIN B,TRUTH		;IF T
	 MOVE B,V%TYO
IFN SFA,[
	MOVSI T,AS.SFA		;CHECK IF AN SFA
	TDNE T,ASAR(B)		;SFA BIT SET IN ASAR?
	 JRST PTYO3		;YUP, CALL AS AN SFA
]		;END IFN SFA
	.5LKTOPOPJ
	MOVE T,TTSAR(B)		;SECOND ARG IS FILE
	MOVEI A,TRUTH		;RETURNS T
	JRST TYOF4

IFN SFA,[
PTYO3:	MOVEI C,(A)		;THIRD ARG IS THE FIXNUM
	MOVEI A,(B)		;FIRST ARG IS SFA ITSELF
	MOVEI B,Q%TYO		;TYO OPERATION
	JRST ISTCSH		;DO FAST INTERNAL CALL
]		;END IFN SFA

PTYO2:
IFN SFA,[
	JSP TT,AFOSP		;CHECK FOR AN SFA
	 JFCL
	 SKIPA			;NOPE
	  JRST PTYO3		;YUP, SO CALL IT
]		;END IFN SFA
	JSP T,FXNV1
	MOVEI AR1,(B)
	PUSHJ P,ATOFOK
	UNLOCKI			;MARGINAL DANGER THAT FILE COULD
	JRST PTYO1		; GET SCEWED BY INTERRUPT HERE

]		;END OF IFN QIO
SUBTTL	PRINT, PRIN1, PRINC

IFE QIO,[

%PRINT:
PRINT:	MOVEI R,TYO	;LIKE (PROG2 (TERPRI) (PRIN1 X) (TYO 40))
	PUSHJ P,ITERPRI
CTY1:	PUSHJ P,PRIN1
CTY2:	%SPC%
	POPJ P,


PRIN1B:	MOVE A,B
%PRIN1:
PRIN1:	 SKIPA R,[PR.ATR,,TYO]
%PRINC:
PRINC:	  MOVE R,[PR.PRC,,TYO]
	PUSHJ P,PRINTY
	JRST TRUE
]		;END OF IFE QIO

IFN QIO,[

PRINT:	SKIPE AR1,TAPWRT	;INTERNAL "SUBR" VERSION OF PRINT
	 MOVE AR1,VOUTFILES
SFA$	JSP F,PRTSTR		;DO SFA CHECKING STUFF
SFA$	[SO.PRT,,]
	JRST $PRINT

%PRINT:	 JSP F,PRNARG		;LSUBR (1 . 2)
SFA%	  JFCL [Q%PRINT]
SFA$	  JFCL [SO.PRT,,Q%PRINT]
$PRINT:	JSP T,GTRDTB		;AR1 SHOULD BE SET UP BEFORE COMING HERE
	PUSHJ P,ITERPRI
CTY1:	PUSHJ P,$PRIN1
CTY2:	%SPC%
	POPJ P,

PRIN1B:	MOVE A,B
PRIN1:	SKIPE AR1,TAPWRT	;INTERNAL "SUBR" VERSION OF PRIN1
	 MOVE AR1,VOUTFILES
SFA$	JSP F,PRTSTR
SFA$	[SO.PR1,,]
	JRST $PRIN1
%PRIN1:	
%PR1:	 JSP F,PRNARG		;LSUBR (1 . 2)
SFA%	  JFCL [Q%PR1]
SFA$	  JFCL [SO.PR1,,Q%PR1]
$PRIN1:	MOVE R,[PR.ATR,,$TYO]	;AR1 SHOULD BE SET UP BEFORE COMING HERE
%PR1A:	JSP T,GTRDTB
	PUSHJ P,PRINTY
	JRST TRUE

PRINC:	SKIPE AR1,TAPWRT	;INTERNAL "SUBR" VERSION OF PRINC
	 MOVE AR1,VOUTFILES
SFA$	JSP F,PRTSTR
SFA$	[SO.PRC,,]
	JRST $PRINC
%PRINC:	
%PRC:	JSP F,PRNARG		;LSUBR (1 . 2)
SFA%	  JFCL [Q%PRC]
SFA$	  JFCL [SO.PRC,,Q%PRC]
$PRINC:	MOVE R,[PR.PRC,,$TYO]	;AR1 SHOULD BE SET UP BEFORE COMING HERE
	JRST %PR1A

;;;	SUBR VERSIONS - *PRINT, *PRIN1, *PRINC 
IFE SFA,[
IRPS X,,[PRT$:PR1$:PRC$:]Y,,[$PRINT,$PRIN1,$PRINC]
X:	JSP F,PRNAR$
		[Q!X]

	JRST Y
TERMIN
]		;END IFE SFA

IFN SFA,[
IRPS X,,[PRT$:PR1$:PRC$:]Y,,[$PRINT,$PRIN1,$PRINC]Z,,[SO.PRT,SO.PR1,SO.PRC]
X:	JSP F,PRNAR$
		[Z,,Q!X]
	JRST Y
TERMIN
]		;END IFN SFA
]		;END OF IFN QIO
SUBTTL	MAIN PRINTOUT ROUTINE

;;; ***** OKAY, OUTPUT LOVERS, HERE'S YOUR MAIN PRINT ROUTINE *****

;;; CALLED WITH OBJECT TO PRINT IN A, ADDRESS OF "TYO" ROUTINE IN R.
;;; CLOBBERS A (RETURNS GARBAGE); TO SAVE A OVER PRINTY, USE APRINT.
;;; VARIOUS BITS ARE KEPT IN THE LEFT HALF OF R.
;;; SOME ARE PASSED IN, AND OTHERS ARE INITIALIZED AND USED INTERNALLY.
PR.PRC==400000		;MUST BE SIGN BIT! 0 => PRIN1, 1 => PRINC. (PASSED IN)
PR.ATR==200000		;1 => DO AUTO-TERPRI HACKS
PR.NUM==4000		;SYMBOL LOOKS LIKE A NUMBER SO FAR
PR.NVB==2000		;NOT PROVEN YET THAT VERTICAL BAR NEEDED
PR.EFC==1000		;EMBEDDED FUNNY CHARACTER IN SYMBOL FLAG (1 => NONE SEEN)
PR.NLS==400		;NOT PROVEN YET THAT LEADING SLASH NEEDED
;;; PRINTA EXPECTS B,C,T,TT,R SAFE OVER THE "TYO" ROUTINE.
;;; THE "TYO" ROUTINE GENERALLY EXPECTS AR1 AND AR2A SAFE OVER PRINTA.
;;; USES DIRECTLY OR INDIRECTLY A,B,C,T,TT,D,R,F.
;;; IN THE USELESS VERSION OF LISP, THERE ARE ABBREVIATION HACKS:
;;; PRINTY IS THE ENTRY FOR PRIN1/PRINC; ABBREVIATION IS CONTROLLED
;;; BY BIT 1.1 OF (STATUS ABBREVIATE). TYOSW INDICATES WHETHER
;;; A CHAR IS MEANT FOR TTY, FILES, OR BOTH (IN THIS WAY THE TTY
;;; CAN RECEIVE ABBREVIATIONS WHILE FILES RECEIVE FULL S-EXPRS).
;;; PRINTF IS THE ENTRY FOR FLATSIZE/EXPLODE; ABBREVIATION IS
;;; CONTROLLED BY BIT 1.2 OF (STATUS ABBREVIATE).
;;; PRINTA IS THE ENTRY FOR ALL OTHER PRINT HACKERS; IT
;;; NEVER ABBREVIATES.

IFE USELESS,[
PRINTY:
IFE QIO,[
	SKIPN TAPWRT		;ENTRY FOR PRIN1/PRINC
	 SKIPN TTYOFF		;FAST RETURN IF NO DEVICES ENABLED
	  JRST PRINTA
IT$	SKIPN LPTON
	 POPJ P,
]		;END OF IFE QIO
	SKIPE V%TERPRI		;TERPRI NON-NIL => NEVER AUTO-TERPRI
PRINTF:			;ENTRY FOR FLATSIZE/EXPLODE
PRINTA:  TLZ R,PR.ATR	;OTHER GUYS DON'T WANT AUTO-TERPRI HACKS
PRINT3:	PUSH P,A	;MAIN RECURSIVE ENTRY FOR PRINTING
	ROT A,-SEGLOG	;NOTE THAT A IS SAFE ON PDL
 	SKIPL TT,ST(A)	;MUST DO A ROT, NOT LSH! SEE PRINX
	 JRST PRINX
	%LPAR%		;PRINT A LIST. FIRST TYO A (
PRINT4:	HLRZ A,@(P)
IFN HNKLOG,[
	TLNE TT,HNK
	 JRST PRINH0
PRINH6:
]		;END OF IFN HNKLOG
	PUSHJ P,PRINT3	;NOW PRINT CAR OF THE LIST
	HRRZ A,@(P)
	JUMPE A,PRIN8A	;IF CDR IS NIL, NEED ONLY A )
PRIN7A:	MOVEM A,(P)
	%SPC%		;ELSE SPACE IN BETWEEN
	LSH A,-SEGLOG	;WE KNOW A IS NON-NIL!
 	SKIPGE TT,ST(A)
	 JRST PRINT4	;IF CDR IS NON-ATOMIC, LOOP
	%DOT%		;ELSE DOTTED LIST
	%SPC%
	PUSHJ P,PRIN1A	;SO PRINT THE ATOM AFTER THE LISP DOT
PRIN8A:	%RPAR%		;NOW TYO A )
	JRST POP1J
]		;END OF IFE USELESS

IFN USELESS,[

PRINTY:	MOVEI D,PRINT1		;ENTRY FOR PRIN1/PRINC
	SKIPE V%TERPRI
	 TLZ R,PR.ATR		;TERPRI NON-NIL => NEVER AUTO-TERPRI
	JRST PRINT0

PRINTF:	MOVEI D,PRINT2		;ENTRY FOR FLATSIZE/EXPLODE
	TLZ R,PR.ATR
	JRST PRINT0

APRINT:	PUSH P,A
	PUSH P,CPOPAJ
PRINTA:	MOVEI D,PRIN3A	;ENTRY FOR NO ABBREVIATIONS
	TLZ R,PR.ATR
PRINT0:	PUSH P,A	;CLOBBERS ARG (RETURNS GARBAGE)
	SKIPN V.RSET	;IF IN *RSET MODE, CHECK VALUES OF
	 JRST PRIN0A	; PRINLEVEL AND PRINLENGTH
IRP X,,[%LEVEL,%LENGTH]Y,,[%LV,%LN]
Y!CHK:	SKIPN A,V!X	;NIL IS A VALID VALUE
	 JRST PRT!Y
	SKOTT A,FX
	 JRST Y!ERR
	SKIPGE (A)
	 JRST Y!ERR
PRT!Y:
TERMIN
PRIN0A:	SETOM PRINLV	;PRINLV HAS <ACTUAL PRINT LEVEL>-1
	SETZM ABBRSW	;ASSUME ABBRSW ZERO
	JSP T,RSXST
	MOVEI A,LRCT-2	;GET (STATUS ABBREVIATE)
NW%	HRRZ T,@RSXTB
NW$	LDB T,[001120,,RSXTB]	;PICK UP CHTRAN
	HRRZ A,(P)	;MUST LEAVE ARG IN A FOR PRINT3
	SETZM PRPRCT
	JRST (D)	;DISPATCH TO PRINT1, PRINT2, PRINT3

PRINT1:	SETOM ABBRSW	;PRIN1/PRINC
IT$ Q%	SKIPN LPTON	;IF ANY FILES OPEN, MUST DECIDE WHETHER
	 SKIPE TAPWRT	; OR NOT TO ABBREVIATE THEM
	  JRST PRIN1Q
	SKIPN TTYOFF	;IF NO FILES OPEN, THEN ABBREVIATE FOR TTY
	 JRST PRIN3A
Q%	JRST POPAJ	;IF NO OUTPUT AT ALL, JUST GIVE UP!
PRIN1Q:	TRNN T,1	;ULTIMATE DECISION ON FILE ABBREVIATION
	 HRRZS ABBRSW	; COMES FROM (STATUS ABBREVIATE)
	JRST PRIN3A

PRINT2:	TRNE T,2	;FLATSIZE/EXPLODE - DECIDE WHETHER IT
	 SETOM ABBRSW	; WANTS ABBREVIATION OR NOT
	JRST PRIN3A
PRINT3:	PUSH P,A	;MAIN RECURSIVE ENTRY FOR PRINTING
PRIN3A:	ROT A,-SEGLOG	;NOT LSH! SEE PRINX
	SKIPL TT,ST(A)
	 JRST PRINX	;IF SO, USE AN ATOM PRINTER
	MOVE T,TYOSW	;SAVE OLD VALUE OF TYOSW
	HRLM T,-1(P)	; (I.E. THAT OF PREVIOUS LEVEL)
	JUMPN T,PRINT4	;IF PREVIOUS LEVEL WAS NON-ABBREV,
	SKIPN ABBRSW	; OR IF WE DON'T EVER WANT ABBREV,
	 JRST PRINT4	; THEN NEEDN'T TRY TO ABBREV!
	AOS T,PRINLV	;ELSE INCREMENT LEVEL COUNT
	SKIPE V%LEVEL	;IF PRINLEVEL=NIL, OR IF ACTUAL LEVEL
	 CAMGE T,@V%LEVEL	; IS LESS, THEN DON'T ABBREV
	  JRST PRINT4
	SKIPL ABBRSW
	 SETOM TYOSW
	CAME T,@V%LEVEL	;IF WE'RE EXACTLY EQUAL TO PRINLEVEL,
	 JRST PRIN3F
	MOVEI T,1
	PUSHJ P,PRINLP
	%NMBR%		; SHOOT OUT LEVEL ABBREVIATION
PRIN3F:	SKIPGE ABBRSW	;IF WE ONLY WANT ABBREVIATION,
	 JRST PRINT9	; NEEDN'T GROVEL OVER THE SUBLIST
	HRRZS TYOSW	;ELSE SIGNAL NON-ABBREV ONLY MODE
PRINT4:	PUSH FXP,PRPRCT	;SAVE PARENS COUNTS
	HLLOS PRPRCT	;CLEAR RIGHT PARENS COUNT, AND
	AOS PRPRCT	; INCREMENT LEFT PARENS COUNT
	PUSH FXP,XC-1	;<ACTUAL PRINT LENGTH>-1 FOR THIS LEVEL
	MOVE T,TYOSW	;SAVE CURRENT TYOSW (DETERMINES WHETHER
	HRLM T,(P)	; ABBREV MODE OUTPUT WANTS A ) AT END)
PRINT5:	SKIPN TYOSW	;IF WE ARE IN NON-ABBREV ONLY MODE,
	 SKIPN ABBRSW	; OR IF WE NEVER WANT ABBREV,
	  JRST PRINT7	; THEN DON'T TRY TO ABBREV!
	AOS T,(FXP)	;ELSE INCREMENT PRINT LENGTH
	SKIPE V%LENGTH	;IF PRINLENGTH=NIL, OR IF WE'RE LESS
	 CAMGE T,@V%LENGTH	; THAN IT, THEN DON'T ABBREV
	  JRST PRINT7
	SKIPL ABBRSW
	 SETOM TYOSW
	CAME T,@V%LENGTH
	 JRST PRINT6	;IF WE'RE EXACTLY EQUAL, THEN ABBREV
	MOVEI T,3
	PUSHJ P,PRINLP
REPEAT 3, %DOT%
PRINT6:	SKIPGE ABBRSW	;IF WE DON'T WANT NON-ABBREV ONLY MODE,
	 JRST PRINT8	; THEN CAN IGNORE REST OF LIST
	HRRZS TYOSW	;ELSE SIGNAL NON-ABBREV ONLY MODE
PRINT7:	HRRZ A,(P)
	HRRZ B,(A)
	HLRZ A,(A)
	HRRZ T,-1(FXP)
	ADDI T,1
	SKIPN B
	 HRRM T,PRPRCT
IFN HNKLOG,[
	TLNE TT,HNK
	 JRST PRINH0
PRINH6:
]		;END OF IFN HNKLOG
	PUSHJ P,PRINT3	;SO PRINT THE CAR OF THE LIST
	SETZM PRPRCT
	HRRZ A,(P)
	HRRZ A,(A)
	JUMPE A,PRINT8	;IF CDR IS NIL, NEED ONLY A ) NOW
PRIN7A:	HRRM A,(P)
	%SPC%		;ELSE SPACE BETWEEN
	LSH A,-SEGLOG
	SKIPGE TT,ST(A)
	 JRST PRINT5	;IF CDR NON-ATOMIC, THEN LOOP
	%DOT%		;ELSE WE HAVE A DOTTED LIST
	%SPC%
	HRRZ T,-1(FXP)
	ADDI T,1
	MOVEM T,PRPRCT
	PUSHJ P,PRIN1A	;PRINT THE ATOM AFTER THE LISP DOT
PRINT8:	HLRZ T,(P)	;THIS WILL TELL TYO WHAT TO
	MOVEM T,TYOSW	; DO WITH THE )
PRIN8A:	SUB FXP,R70+1
	POP FXP,PRPRCT
	%RPAR%		;TYO A ) TO END THE LIST
PRINT9:	HLRZ T,-1(P)	;RESTORE TYOSW TO WHAT IT WAS
	MOVEM T,TYOSW	; ON LAST (RECURSIVE!) ENTRY
	JUMPN T,POP1J	;IF AND ONLY IF WE AOS'ED PRINLV,
	SKIPE ABBRSW	; WE MUST NOW SOS IT, AND THEN POP1J
	 SOS PRINLV
	JRST POP1J
]		;END OF IFN USELESS
SUBTTL	PRINT A HUNK

IFN HNKLOG,[

PRINH0:	SKIPN VHUNKP		;IF HUNKP IS NIL, THEN PRINT A HUNK
	 JRST PRINH6		; AS IF IT WERE A LIST CELL
	PUSH FXP,TT
	PUSHJ P,PRINT3		;PRINT A HUNK SEEN FOR A LIST CELL
IFN USELESS,	SETZM PRPRCT
	POP FXP,TT
	MOVSI T,-2
   2DIF [LSH T,(TT)]0,QHUNK1
	HRR T,(P)
	ADD T,R70+1
	PUSH P,T
PRINH1:	MOVEM T,(P)
	HRRZ A,(P)
	HRRZ A,(A)
	CAIN A,-1
	 JRST PRINH3
	%SPC%
	%DOT%
	%SPC%
	PUSHJ P,PRINT3
	HRRZ A,(P)
	HLRZ A,(A)
	CAIN A,-1
	 JRST PRINH3
	%SPC%
	%DOT%
	%SPC%
	PUSHJ P,PRINT3
	MOVE T,(P)
	AOBJN T,PRINH1
PRINH3:	SUB P,R70+1
	HRRZ A,(P)
	HRRZ A,(A)
;	JUMPN A,PRIN7A
	JUMPN A,PRINH4
IFN USELESS,[
	HLRZ T,(P)
	MOVEM T,TYOSW
	MOVEI T,2
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
	%SPC%
	%DOT%
	JRST PRIN8A

PRINH4:	MOVEI TT,(A)		;KLUDGE
	LSH TT,-SEGLOG
	SKIPL ST(TT)
	 JRST PRIN7A
REPEAT 2, %SPC%
	JRST PRIN7A

]		;END OF IFN HNKLOG
SUBTTL	PRINT ATOM DISPATCH, AND PRINT AN ARRAY OR A RANDOM

PRINX:	PUSH P,CPOP1J		;PRINT AN ATOM (ON THE PDL)
PRIN1A:				;TT HAS ST ENTRY
	HRRZ A,-1(P)		;NIL IS SYMBOL, NOT RANDOM!!!
	JUMPE A,PRINIL
   2DIF JRST (TT),.,QLIST	.SEE STDISP	;TT MUST HAVE ST ENTRY
PRIN1Z:	JRST PRINI	;FIXNUM
	JRST PRINO	;FLONUM
DB$	JRST PRINDB	;DOUBLE
CX$	JRST PRINCX	;COMPLEX
DX$	JRST PRINDX	;DUPLEX
BG$	JRST PRINB	;BIGNUM
	JRST PRINN	;SYMBOL
REPEAT HNKLOG, .VALUE	;HUNKS
	JFCL		;RANDOM
IFN .-PRIN1Z-NTYPES+2, WARN [WRONG LENGTH TABLE]
IFN USELESS,[
	MOVEI T,25.
	PUSHJ P,PRINLP
	SETZM PRPRCT
]		;END OF IFN USELESS
	%NMBR%		;ARRAY (AND RANDOM)
	TLNN TT,SA
	 JRST PRINX5
	HRRZ A,-1(P)
	MOVE TT,ASAR(A)
	CAIE TT,ADEAD
	 JRST PRINA2
	SKIPA TT,[440700,,[ASCIZ \DEAD-ARRAY\]]
PRINA1:	 PUSHJ P,(R)
	ILDB A,TT
	JUMPN A,PRINA1
	POPJ P,

PRINA2:
Q$	TLNE TT,AS<FIL>
Q$	 JRST PRNFL
Q$	TLNE TT,AS<JOB>
Q$	 JRST PRNJB
SFA$	TLNE TT,AS.SFA		;SFA?
SFA$	 JRST PRNSR
	JFFO TT,.+1
	HRRZ A,ARYTYP(D)
	TLC TT,AS<SX>		;CROCK FOR NSTORE ARRAYS
	TLNN TT,AS<SX+GCP>
	 SETZ A,
	PUSHJ P,PRINSY
	%NEG%
	HRRZ A,-1(P)
	LDB F,[TTSDIM,,TTSAR(A)]
PRINA3:	HRRZ A,-1(P)
	MOVNI TT,(F)
	MOVE TT,@TTSAR(A)
IFE USELESS,	MOVE C,@VBASE		;BETTER BE A FIXNUM!
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
	SOJE F,PRINA4
	%CLN%
	JRST PRINA3
PRINA4:	%NEG%
PRINX5:	HRRZ TT,-1(P)
PRINL4:	MOVEI C,10	;N BASE 8
	JRST PRINI3
IFN QIO,[

SUBTTL	PRINT A FILE OBJECT, PRINT A JOB OBJECT, PRINT AN SFA

;;; PRINT A JOB OBJECT AS #JOB-|<NAME>|-<ADDRESS>
;;; PRINT A FILE OBJECT AS #FILE-<DIR>-|<NAME>|-<ADDRESS>
;;; PRINT AN SFA AS #SFA-|<SFA-PRINTNAME>|-<ADDRESS>
;;; WHERE <DIR> IS "IN" OR "OUT", <NAME> IS THE TRUENAME,
;;; <SFA-PRINTNAME> IS THE THING GIVEN AS THE THIRD ARG TO CREATE-SFA
;;; AND <ADDRESS> IS THE OCTAL ADDRESS OF THE SAR.

IFN SFA,[
PRNSR:	MOVEI T,[ASCIZ \SFA-\]
	JRST PRNF5
]		;END IFN SFA
PRNJB:	MOVEI T,[ASCIZ \JOB-\]
	JRST PRNF5
PRNFL:	MOVEI T,[ASCIZ \FILE-\]
PRNF5:	PUSHJ P,PRNSTO
	HRRZ A,-1(P)
	MOVE TT,ASAR(A)
SFA$	TLNE TT,AS.SFA		;SFA?
SFA$	 JRST PRNSR1		;YES, PRINT DIFFERENTLY
	PUSH FXP,TT
	TLNE TT,AS.JOB		;DON'T PRINT DIR FOR JOB ARRAY
	 JRST PRNF6
	MOVE TT,TTSAR(A)
;FORMERLY, THIS ROUTINE USED PRINSY TO PRINT IN OR OUT.  BUT, SINCE THIS
;ROUTINE CAN BE CALLED FROM THE GARBAGE COLLECTOR, THE POINTERS COULD BE
;MARKED AND THEREFORE INVALID.  TO AVOID PRINTING LOSSAGE, PRINTING IS DONE
;MANUALLY.
	MOVEI T,[ASCII \IN\]	;ASSUME INPUT FILE
	TLNE TT,TTS<IO>
	 MOVEI T,[ASCII \OUT\]
	PUSHJ P,PRNSTO
	%NEG%
PRNF6:	%VBAR%
	POP FXP,T		    ;SAVED ASAR
	MOVNI TT,LPNBUF
	PUSH FXP,PNBUF+LPNBUF(TT)   ;UNFORTUNATELY, SOMEONE MIGHT BE USING 
	AOJL TT,.-1		    ; PNBUF, SO WE MUST SAVE IT
	HRRZ A,-1(P)
	PUSH FXP,R
20$	MOVE TT,TTSAR(A)	;FOR D20 CLOSED FILE NEEDS SPECIAL HANDLING
20$	TLNN TT,TTS.CL		;CLOSED? (ASAR SAVED IN T)
	TLNE T,AS.JOB		;DON'T GET TRUENAME FOR JOB ARRRAYS
	 JRST PRNJ1
	PUSHJ P,TRU6BT		;GET TRUENAME OF FILE ON FXP
PRNJ2:	PUSH P,[-1]		;MAKE SURE LONG NAMESTRING
	PUSHJ P,6BTNS		;CONVERT THAT TO A NAMESTRING IN PNBUF
	POPI P,1
	POP FXP,R
	MOVEI TT,-LPNBUF+1(FXP)
	MOVSI T,-LPNBUF
PRNF1:	MOVE D,PNBUF(T)		;SWAP PNBUF WITH COPY ON PDL
	EXCH D,(TT)
	MOVEM D,PNBUF(T)
	ADDI TT,1
	AOBJN T,PRNF1
	MOVEI T,-LPNBUF+1(FXP)
	PUSHN FXP,1			;BE SURE STRING ENDS WITH ZEROS
	PUSHJ P,PRNSTO
	POPI FXP,LPNBUF+1		;POP THE CRUD
	%VBAR%
	JRST PRINA4

PRNSTO:	HRLI T,440700
	ILDB A,T
	JUMPE A,CPOPJ
	PUSHJ P,(R)
	JRST .-3

PRNJ1:	HRRZ TT,TTSAR(A)
	HRLI TT,-L.F6BT
20%	PUSH FXP,F.RDEV(TT)
20$	PUSH FXP,F.DEV(TT)
	AOBJN TT,.-1
	JRST PRNJ2
]		;END OF IFN QIO
IFN SFA,[
PRNSR1:	%VBAR%
	MOVEI TT,SR.PNA		;GET THE PNAME
	HRRZ A,-1(P)		;PICK UP ARRAY POINTER
	HRRZ A,@TTSAR(A)
	PUSH FXP,R		;REMEMBER R OVER RECURSIVE CALL TO PRINT
	TLO R,PR.PRC
	PUSHJ P,PRINTA		;PRINT THE NAME
	POP FXP,R
	%VBAR%
	JRST PRINA4
]		;END IFN SFA
SUBTTL	PRINT AN ATOMIC SYMBOL

;PRINIL:
;IFN USELESS, PUSHJ P,PLP1
;	MOVEI A,"(		;PRINT () FOR NIL
;	PUSHJ P,(R)
;	MOVEI A,")
;	JRST (R)

PRINSY:	PUSH P,A
	PUSH P,CPOP1J
	JUMPE A,PRINIL
PRINN:	SKIPA A,-1(P)
PRINIL:	 MOVEI A,[$$$NIL,,]
	JSP C,MAPNAME
	JUMPGE R,PRNN2		.SEE PR.PRC
IFN USELESS,	PUSHJ P,PLP1
PRNN1:	JSP C,(C)		;FOR PRINC, JUST OUTPUT THE CHARS
	 POPJ P,
	MOVEI A,(TT)
	PUSHJ P,(R)
	JRST PRNN1

PRNN2A:
IFN USELESS,[
	HLRZ T,PRPRCT
PRNN2B:	SOJL T,PRNN2C
	%LPAR%
	JRST PRNN2B
PRNN2C:	HRRZS PRPRCT
]	;END OF IFN USELESS
	%VBAR%			;FOR NULL PNAME, PRINT ||
	%VBAR%
	JRST PLP1

PRNN2:	JSP C,(C)		;GET FIRST CHAR
	 JRST PRNN2A		;FOR NULL PNAME, JUST PRINT HANGING LEFT PARENS
	TLO R,PR.NVB+PR.NUM+PR.EFC+PR.NLS
	SETZ F,			;F COUNTS: <# SLASHES,,# CHARS>
	HRRZ A,VREADTABLE
	MOVE D,@TTSAR(A)
	TLNN D,14		;IF NOT A DIGIT OR A SIGN,
	 TLZ R,PR.NUM		; THEN IT ISN'T NUMBER-LIKE
	TLNN D,400		;IF NOT SLASHIFIED AS FIRST CHAR,
	 AOJA F,PRNN3A		; JUST BUMP CHAR COUNTER
	TLZ R,PR.EFC		;ELSE ONE FUNNY CHAR SEEN ALREADY
	TLNE D,171000		;REAL WEIRDIES FORCE VERTICAL BARS
	 TLZ R,PR.NVB
PRNN3:	ADD F,R70+1		;BUMP CHAR COUNT AND SLASH COUNT
PRNN3A:	JSP C,(C)		;GET NEXT CHAR
	 JRST PRNN4
	MOVE D,@TTSAR(A)
	TLNN D,24		;IF IT LOOKS LIKE A NUMBER SO FAR
	 TLZN R,PR.NUM		; BUT THIS NEXT CHAR ISN'T DIGIT OR ARROW,
	  JRST PRNN3B
	TRNE F,777770		; THEN WE NEED A LEADING SLASH IF THERE WERE
	 TLZ R,PR.NLS		; MORE THAN SEVEN LEADING NUMBER-LIKE CHARS
PRNN3B:	TLNN D,100		;IF NOT SLASHIBLE IN FIRST POSITION,
PRNN3C:	 AOJA F,PRNN3A		; JUST BUMP CHAR COUNTER
	TLNN D,2000		;VERTICAL BARS CAN'T HELP A SLASH
	 CAIN TT,"|		; OR VERTICAL BAR, SO COUNT THEM AS
	  AOJA F,PRNN3C		; TWO CHARACTERS AND NO SLASHES
	TLNN D,171000		;REAL WEIRDIES
	 TLZN R,PR.EFC		; OR TWO EMBEDDED FUNNY CHARS
	  TLZ R,PR.NVB		; FORCE VERTICAL BARS
	JRST PRNN3
PRNN4:	CAIN F,1		;A SIGN WITH NO FOLLOWING
	 TLNN D,10		; DIGITS DOESN'T NEED A SLASH
	  CAIA
	   JRST PRNN4A
	TLNE R,PR.NUM		;IF THE WHOLE THING IS NUMBER-LIKE,
	 TLZ R,PR.NLS		; THEN DEFINITELY NEED A LEADING SLASH
PRNN4A:	MOVEI T,2(F)
	TLNN R,PR.NVB
	 JRST PRNN4B
	HLRZ T,F		;WE AREN'T USING VERTICAL BARS
	ADDI T,1(F)		; SO MUST COMPUTE UP ROOM TAKEN BY
	TLNN R,PR.NLS		; CHARS AND SLASHES, PLUS ONE FOR THE SPACE
	 ADDI T,1		; WHICH MAY FOLLOW
PRNN4B:	PUSHJ P,PRINLP
	SKIPN A,-1(P)
	 MOVEI A,[$$$NIL,,]
	JSP C,MAPNAME
	TLNE R,PR.NVB
	 JRST PRNN6
	%VBAR%			;DO THE VERTICAL BAR THING
PRNN5:	JSP C,(C)
	 JRST VBARPOPJ
	CAIE TT,↑M
	 CAIN TT,"|
	  JRST PRNN5A
	MOVE A,VREADTABLE
	MOVE D,@TTSAR(A)
	TLNE D,2000
PRNN5A:	 %SLSH%
	MOVEI A,(TT)
	PUSHJ P,(R)
	JRST PRNN5

VBARPOPJ: %VBAR%
	POPJ P,

PRNN6:	MOVEI F,400
PRNN6A:	JSP C,(C)
	 POPJ P,
20$	PUSH P,B		;B MUST BE PRESERVED
	MOVE A,VREADTABLE
	MOVE D,@TTSAR(A)
	TLOE R,PR.NLS
	 TLNE D,(F)
	  %SLSH%
	MOVEI A,(TT)
	PUSHJ P,(R)
20$	POP P,B
	MOVEI F,100
	JRST PRNN6A
;;; COROUTINE TO DELIVER UP CHARACTERS OF A PRINT NAME.
;;; USES JSP C,(C) TO CALL.  USES B, T; YIELDS CHARS IN TT.
;;; SETUP USES A.  SKIPS UNLESS NO MORE CHARS.

MAPNAME:
	HLRZ B,(A)
	HRRZ B,1(B)
	JSP C,(C)
MAPNM1:	HLRZ T,(B)
	MOVE T,(T)
	TRZ T,1			;FORCE OFF LOW ORDER BIT, IS UNUSED IN ASCII
MAPNM2:	SETZ TT,
	ROTC T,7
	SKIPN T			;ONLY CHECK FOR NULLS IF AT THE END OF THE WORD
	 JUMPE TT,MAPNM3
	JSP C,1(C)
	JRST MAPNM2

MAPNM3:	HRRZ B,(B)
	JUMPN B,MAPNM1
	JRST (C)


;;; ROUTINE TO FEED FORMATTING INFORMATION TO TYO IF DESIRED,
;;; THEN PRINT ANY PENDING LEFT PARENTHESES.
;;; THE LENGTH OF THE ATOM TO BE PRINTED IS IN T.
;;; USES ONLY A AND T.

PRINLP:	TLNN R,PR.ATR
	 JRST PLP1
IFN USELESS,[
	MOVSI T,(T)
	ADD T,PRPRCT
	HLRZ T,T
	ADD T,PRPRCT
]		;END OF IFN USELESS
	TRNE T,777000
	 MOVEI T,777
	HRROI A,1(T)		;ALLOW FOR FOLLOWING SPACE
	 PUSHJ P,(R)
PLP1:				.SEE PRNN1
IFE USELESS,	POPJ P,
IFN USELESS,[
	HLRZ T,PRPRCT
PRINLQ:	SOJL T,CPOPJ
	%LPAR%
	JRST PRINLQ
]		;END OF IFN USELESS
SUBTTL	PRINT A FIXNUM

PRINI:	MOVE A,VBASE
IFN USELESS,	CAIN A,QROMAN
IFN USELESS,	 JRST PRINRM
	SKOTT A,FX
	 JRST BASER
	MOVE C,(A)		;TRUE VALUE OF BASE IN C
	CAIG C,36.
	 CAIGE C,2
	  JRST BASER
PRI2D:	HRRZ A,-1(P)
	JSP T,FXNV1		;THE TYO ROUTINE MUST SAVE TT HERE
IFN USELESS,[
	MOVMS TT		;ESTIMATE LENGTH OF FIXNUM
	JFFO TT,.+2		; ASSUMING OCTAL BASE
	 MOVEI D,43
	MOVNI T,3
	IDIVM D,T		;AVOID CLOBBERING EXTRA ACS
	ADDI T,14
	SKIPGE @-1(P)		;ALLOW FOR MINUS SIGN
	 ADDI T,1
	PUSHJ P,PRINLP
	MOVE TT,@-1(P)
]		;END OF IFN USELESS
	CAIN C,8		;FOR OCTAL NUMBERS, WE MAY WANT
	 JRST PRI2B		; TO USE A FUNNY SHIFTED FORMAT
PRI2C:	JUMPL TT,PRI2Q
	SKIPE V.NOPOINT
	 JRST PRINI2		;HAPPY PRATT?
	CAILE C,10.
	 %POS%
	JRST PRINI2

PRI2Q:	%NEG%
PRI2A:	MOVNS TT
PRINI2:	JSP T,PRI.		;INSERT DECIMAL POINT IF NECESSARY
PRINI9:	MOVEI T,1		;MUST SAVE F - SEE GCPNT1, GCWORRY
	TLZN TT,400000		;IF NUMBER COULD BE MOBY, THEN MOVE HIGH ORDER BIT
PRINI3:	 SETZ T,		.SEE FP4B1	;MUSTN'T DISTURB B
	JSP D,PRINI5
	SKIPE TT,T
	 PUSHJ P,PRINI3
FP7A1:	HLRZ A,(P)
FP7B:	MOVEI A,"0(A)
	CAIE A,".
	 JRST (R)
	%DCML%
	POPJ P,

PRINI5:	DIVI TT-1,(C)
	CAILE TT,9
	 ADDI TT,"A-"9-1	;KLUDGY DIGITS GREATER THAN 9 ARE "A, B, C, ..., Y, Z"
PRINI7:	HRLM TT,(P)
	JRST (D)

PRI.:	CAIN C,10.		;IF THE RADIX IS 10.
	 SKIPE V.NOPOINT	; AND *NOPOINT IS NOT SET,
	  JRST (T)		; THEN KLUDGILY ARRANGE
	HRLI T,".-"0		; TO PRINT A "." AFTER THE
	HLLM T,(P)		; DIGITS ARE PRINTED
	PUSH P,[FP7A1]
	JRST (T)
PRI2B:	MOVM D,TT
	TRNN D,777
	 TLNN D,-1
	  JRST PRI2C
	MOVEI T,(C)
	MOVE C,VREADTABLE
	MOVE D,TT
	MOVEI TT,LRCT-1		;RH OF LAST RCT ENTRY IS (STATUS ←)
	HRRZ C,@TTSAR(C)
	EXCH T,C
	MOVE TT,D
	JUMPE T,PRI2C
	MOVNI D,11		;PRINT OUT AS ONE OF:
	TRNE TT,777000		;	NNNNNNNNN←11
	 JRST PRI2B3		;	NNNNNN←22
	MOVNI D,22		;	NNN←33
	TLNN TT,777		;	N←41
	 MOVNI D,33		; IN ORDER THAT LOSERS NEED NOT
	TLNN TT,77777		; COUNT ALL THE ZEROS OF AN
	 MOVNI D,41		; OCTAL NUMBER.
PRI2B3:	ASH TT,(D)
	PUSH FXP,D
	PUSHJ P,PRI2C
	%BAK%
	POP FXP,TT
	JRST PRI2A

IFN USELESS,[
PROMAN:	AOS (P)
	JRST PRINR0

PRINRM:	HRRZ A,-1(P)
	JSP T,FXNV1
PRINR0:	MOVEI C,10.
	JUMPLE TT,PRI2D
	CAIL TT,4000.
	JRST PRI2D
	MOVEI T,15.
	PUSHJ P,PRINLP
	SETZ T,
PRINR1:	IDIVI TT,10.
	HRLM D,(P)
	ADDI T,1
	JUMPE TT,PRINR2
	PUSHJ P,PRINR1
PRINR2:	HLRZ TT,(P)
	SUBI T,1
	JUMPE TT,CPOPJ
	CAIE TT,9
	JRST PRINR3
	HLRZ A,PRINR9(T)
	PUSHJ P,(R)
	HLRZ A,PRINR9+1(T)
	JRST (R)

PRINR3:	CAIE TT,4
	JRST PRINR4
	HLRZ A,PRINR9(T)
	PUSHJ P,(R)
	HRRZ A,PRINR9(T)
	JRST (R)

PRINR4:	CAIGE TT,5
	JRST PRINR6
	SUBI TT,5
	HRRZ A,PRINR9(T)
PRINR5:	PUSHJ P,(R)
PRINR6:	SOJL TT,CPOPJ
	HLRZ A,PRINR9(T)
	JRST PRINR5

PRINR9:	"I,,"V
	"X,,"L
	"C,,"D
	"M,,
]		;END OF IFN USELESS
SUBTTL	PRINT A FLONUM (SINGLE OR DOUBLE PRECISION)

IFN DBFLAG,[
PRINDB:	
IFN USELESS,[
	MOVEI T,30.		;GROSS ESTIMATE OF LENGTH OF DOUBLE
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
KA	HRRZ A,-1(P)
KA	MOVE T,(A)
KA	MOVE TT,1(A)
KIKL	DMOVE T,@-1(P)
DFP0:
KA	MOVEI B,66		;PRECISION OF "SOFTWARE FORMAT" DOUBLE
KIKL	MOVEI B,76		;PRECISION OF "HARDWARE FORMAT" DOUBLE
	JRST FP0A
]		;END OF IFN DBFLAG

PRINO:
IFN USELESS,[
	MOVEI T,17.		;GROSS ESTIMATE OF LENGTH OF FLONUM
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
	MOVE T,@-1(P)
;A FLONUM TO PRINT IS IN T
FP0:
DB$	MOVEI B,33		;PRECISION OF A FLONUM IN BITS
DB$	SETZ TT,
FP0A:	JUMPGE T,FP0B
	%NEG%
DB%	MOVNS T
DB$ KA	DFN T,TT
DB$ KIKL  DMOVN T,T
FP0B:
;A POSITIVE FLONUM TO PRINT IS IN T (DB$: AND TT); IF DB$, PRECISION IN BITS IS IN B
FP1:
IFN DBFLAG,[
	MOVE F,T		;MAKE A COPY OF NUMBER WITH JUST THE
	AND F,[777400,,]	; MOST SIGNIFICANT BIT SET (ASSUME ARG NORMALIZED)
	PUSH FXP,F		;THIS WILL BE USED FOR A MASK AFTER SCALING
	PUSH FXP,R70		; DOWN BY THE CONTENTS OF B (PRECISION)
	SETZ F,			;F WILL BE THE EXPONENT TO PRINT FOR E/D NOTATION
	CAMGE T,[0.1]
]		;END OF IFN DBFLAG
DB%	SETZB TT,F		;TT IS SECOND WORD FOR T; F WILL BE EXPONENT
DB%	CAMGE T,[0.01]
	 JRST FP4		;0.01 (OR 0.1) AND 1.0↑8 ARE CHOSEN SO THAT THE
	CAML T,[1.0↑8]		; FRACTIONAL PART WILL HAVE AT LEAST ONE
	 JRST FP4E0		; BIT, BUT NOT LOSE ANY OFF THE RIGHT END
DB$	CAILE B,33		;FOR DOUBLE PRECISION, MUST ARRANGE TO PRINT "D0"
DB$	 JRST FP4B1		; AT THE END OF THE NUMBER
IFE DBFLAG,[
;A POSITIVE FLONUM BETWEEN .01 AND 1.0↑8 IS IN T
FP3:	SETZB TT,D
	ASHC T,-33		;SPLIT EXPONENT PART OFF - MANTISSA IN TT
	ASHC TT,-243(T)		;SPLIT NUMBER INTO INTEGRAL AND FRACTIONAL PART
	MOVSI F,200000		;COMPUTE POSITION OF LAST SIGNIFICANT BITS
	ASH F,-243+<43-33>(T)	;F GETS A VALUE EQUAL TO 1/2 LSB
	PUSH FXP,F
	PUSH FXP,D		;SAVE FRACTION
	MOVEI C,10.		;PRINT INTEGER PART AS A DECIMAL FIXNUM
	PUSHJ P,PRINI3
	%DCML%			;PRINT DECIMAL POINT
	POP FXP,TT
;NOW TT HAS FRACTION INFO BITS, AND (FXP) HAS SLIDING MASK BIT (TOLERANCE)
FP3A:	MOVE T,TT		;REMAINING INFO BITS IN TT
	MULI T,10.		;T GETS NEXT DIGIT TO PRINT, MORE OR LESS
	POP FXP,F
	JFCL 8,.+1		;CLEAR OVERFLOW
	IMULI F,10.		;OVERFLOW ON (FSC 231400000001 0) AND (FSC 175631463150 0)
	JFCL 8,FP3A1		;CUT OFF WHEN MASK BIT OVERFLOWS
	CAMGE TT,F
	 JRST FP3A1		; OR WHEN REMAINING INFO BITS ARE BELOW MASK
	MOVN D,F
	TLZ D,400000
	CAMLE TT,D
	 AOJA T,FPX0		;LAST SIG DIGIT, BUT ROUND UPWARDS
	PUSH FXP,F
	PUSHJ P,FPX0		;OUTPUT A DIGIT, AND GO AROUND FOR ANOTHER
	JRST FP3A

FP3A1:	TLNE TT,200000		;SIZE OF REMAINDER DETERMINES ROUNDING
	 ADDI T,1
FPX0:	MOVEI A,"0(T)		;COME HERE TO OUTPUT A DIGIT IN T
	JRST (R)
]		;END OF IFE DBFLAG
IFN DBFLAG,[

;FALLS THROUGH
;;;	IFN DBFLAG

;FALLS IN

;A POSITIVE FLONUM BETWEEN 0.1 AND 10.0↑8 IS IN T AND TT; PRECISION IN BITS IS IN B
; ON FXP, A TWO-WORD MASK VALUE, AS YET UNSCALED BY THE CONTENTS OF B
FP3:
KA	ASH TT,10		;PUT NUMBER IN HARDWARE FORMAT
	LDB F,[331000,,T]	;GET EXPONENT (CANNOT BE LARGER THAN 200+33)
	TLZ T,377000		;CLEAR EXPONENT FROM FRACTION
	PUSH FXP,TT
	SETZ D,
	ASHC TT,-233(F)		;CALCULATE LOW ALIGNED FRACTION WORD
	PUSH FXP,D
	MOVE TT,-1(FXP)
	ASHC T,-233(F)		;CALCULATE HIGH ALIGNED FRACTION WORD
	MOVEM TT,-1(FXP)	;INTEGER PART IS IN T
KA	MOVE TT,-3(FXP)		;GET MASK INTO TT AND D
KA	MOVE D,-2(FXP)
KA	ASH D,10		;CONVERT TO HARDWARE FORMAT
KIKL	DMOVE TT,-3(FXP)
	LDB F,[331000,,TT]	;GET EXPONENT
	TLZ TT,377000		;CLEAR EXPONENT, LEAVING FRACTION
	SUBI F,(B)
	ASHC TT,-200+4(F)	;CALCULATE MASK FRACTION VALUE, BINARY POINT BELOW BIT 4.5
KA	MOVEM TT,-3(FXP)	;SAVE IT BACK ON FXP
KA	MOVEM D,-2(FXP)
KIKL	DMOVEM TT,-3(FXP)
	MOVE TT,T		;PUT INTEGER PART IN TT
	MOVEI C,10.		;PRINT INTEGER PART IN RADIX 10.
	PUSHJ P,PRINI3		;PRESERVES B
	%DCML%
	POP FXP,TT
	POP FXP,T
	ASHC T,-4		;ALIGN FRACTION SO BINARY POINT IS BELOW BIT 4.5

;FALLS THROUGH
;;;	IFN DBFLAG

;FALLS IN

;FRACTION IN T,TT WITH BINARY POINT BELOW BIT 4.5; MASK IN -1(FXP),(FXP)
DFP3A:
	IMULI T,10.		;MULTIPLY FRACTION BY 10.
	MULI TT,10.
	ADD T,TT
	MOVE TT,D
	LDB A,[370400,,T]	;GET NEXT DIGIT (BITS 4.8-4.5) IN A
	MOVEI A,"0(A)		;MAKE IT ASCII
	TLZ T,360000		;FORM REMAINDER IN TT,D
	EXCH T,-1(FXP)		;EXCHANGE FRACTION WITH MASK
	EXCH TT,(FXP)
	IMULI T,10.		;MULTIPLY MASK BY 10.
	MULI TT,10.
	ADD T,TT
	MOVE TT,D
	CAMGE T,-1(FXP)
	 JRST DFP3A1
	CAMG T,-1(FXP)
	 CAMLE TT,(FXP)
	  JRST DFP3A8		;LAST DIGIT IF MASK > FRACTION
DFP3A1:
KA	SETCM D,T		;NEGATE MASK
KA	MOVN F,TT
KA	TLZ F,400000
KA	SKIPN F
KA	 ADDI D,1
KIKL	MOVE D,T
KIKL	MOVE F,TT
KIKL	DMOVN T,T
KA	TLZ D,760000		;FORM 1-MASK
KIKL	TLZ T,760000
KA	CAMLE D,-1(FXP)
KIKL	CAMLE T,-1(FXP)
	 JRST DFP3A2
KA	CAML D,-1(FXP)
KIKL	CAML T,-1(FXP)
KA	 CAMGE F,(FXP)
KIKL	 CAMGE TT,(FXP)
	  AOJA A,DFP3A9		;LAST DIGIT, ROUNDED UP, IF FRACTION > 1-MASK
DFP3A2:
KA	EXCH T,-1(FXP)		;EXCHANGE BACK MASK FOR FRACTION
KA	EXCH TT,(FXP)
KIKL	DMOVE T,-1(FXP)
KIKL	MOVEM D,-1(FXP)
KIKL	MOVEM F,(FXP)
	PUSHJ P,(R)		;OTHERWISE OUTPUT DIGIT AND
	JRST DFP3A		; GO AROUND AGAIN

DFP3A8:	MOVE TT,-1(FXP)		;ROUND LAST DIGIT UP IF FRACTION >= 1/2
	TLNE TT,10000
	 ADDI A,1
DFP3A9:	SUB FXP,R70+2
	JRST (R)

KIKL	D10.0:	10.0  ?  0
KIKL	D1.0E8:	1.0↑8  ?  0

]		;END OF IFN DBFLAG
;HERE ON FLONUMS < 0.01 (DB%) OR < 0.1 (DB$)
FP4:	JUMPN T,FP4E		;FLOATING POINT "E" FORMAT
DB$	CAILE B,33		;FOR DOUBLE PRECISION,
DB$	 PUSH P,[[%D% ? JRST FP4A]]	;PRINT "0.0D0" CLEVERLY
	PUSHJ P,FP4A		;CLEVER WAY TO PRINT OUT "0.0" QUICKLY
	%DCML%
FP4A:	MOVEI A,"0
	JRST (R)

;HERE ON FLONUMS >= 1.0E8
FP4E0:
KA	FDVL T,[1.0↑8]		;BE DOUBLY PRECISE IN DIVIDING
KA	FDVR TT,[1.0↑8]		; BY 10↑8 TO GET NUMBER IN RANGE
KA	FADL T,TT
KIKL	DFDV T,D1.0E8
IFN DBFLAG,[
	EXCH T,-1(FXP)
	EXCH TT,(FXP)
KA	FDVL T,[1.0↑8]		;DIVIDE MASK TOO
KA	FDV TT,[1.0↑8]		;UNROUNDED!
KA	FADL T,TT
KIKL	DFDV T,D1.0E8
	EXCH T,-1(FXP)
	EXCH TT,(FXP)
]		;END OF IFN DBFLAG
	ADDI F,8
	CAML T,[1.0↑8]
	 JRST FP4E0		;KEEP DIVIDING UNTIL < 10↑8
FP4E1:	CAMGE T,[10.0]
	 JRST FP4B
KA	FDVL T,[10.0]		;NOW REDUCE UNTIL < 10.0
KA	FDVRI TT,(10.0)
KA	FADL T,TT
KIKL	DFDV T,D10.0
IFN DBFLAG,[
	EXCH T,-1(FXP)
	EXCH TT,(FXP)
KA	FDVL T,[10.0]		;DIVIDE MASK TOO
KA	FDV TT,[10.0]		;UNROUNDED!
KA	FADL T,TT
KIKL	DFDV T,D10.0
	EXCH T,-1(FXP)
	EXCH TT,(FXP)
]		;END OF IFN DBFLAG
	AOJA F,FP4E1

;HERE FOR NON-ZERO FLONUMS < 0.01 (DB%) OR < 0.1 (DB$)
FP4E:	CAML T,[1.0↑-8]		;BE DOUBLY PRECISE IN MULTIPLYING BY 10↑8
	 JRST FP4E2A
KA	FMPR TT,[1.0↑8]
KA	MOVEM TT,D
KA	FMPL T,[1.0↑8]
KA	UFA TT,D
KA	FADL T,D
KIKL	DFMP T,D1.0E8
IFN DBFLAG,[
	EXCH T,-1(FXP)
	EXCH TT,(FXP)
KA	FMP TT,[1.0↑8]		;UNROUNDED!  MULTIPLY MASK TOO
KA	MOVEM TT,D
KA	FMPL T,[1.0↑8]
KA	UFA TT,D
KA	FADL T,D
KIKL	DFMP T,D1.0E8
	EXCH T,-1(FXP)
	EXCH TT,(FXP)
]		;END OF IFN DBFLAG
	SUBI F,8
	JRST FP4E

FP4E2:
KA	FMPRI TT,(10.0)		;NOW INCREASE UNTIL >= 1.0
KA	MOVEM TT,D
KA	FMPL T,[10.0]
KA	UFA TT,D
KA	FADL T,D
KIKL	DFMP T,D10.0
IFN DBFLAG,[
	EXCH T,-1(FXP)
	EXCH TT,(FXP)
KA	FMP TT,[10.0]		;UNROUNDED!  MULTIPLY MASK TOO
KA	MOVEM TT,D
KA	FMPL T,[10.0]
KA	UFA TT,D
KA	FADL T,D
KIKL	DFMP T,D10.0
	EXCH T,-1(FXP)
	EXCH TT,(FXP)
]		;END OF IFN DBFLAG
FP4E2A:	CAMGE T,[1.0]
	 SOJA F,FP4E2
;HERE WHEN NUMBER BETWEEN 1.0 (INCL) AND 10.0 (EXCL); F IS THE EXPONENT TO BE PRINTED.
FP4B:
IFE DBFLAG,[
KIKL	TLNN TT,200000		;DECIDE WHETHER ROUNDING WILL HAVE ANY EFFECT
KIKL	 JRST FP4B1
KIKL	HLLZ TT,T		;IF SO, CREATE A FLONUM WHOSE VALUE IS
KIKL	TLZ TT,777		; 1/2 LSB OF FRACTION IN T
KIKL	ADD TT,[777000,,1]
	FADR T,TT		;ADD LOW PART TO HIGH PART, ROUNDING
	CAMGE T,[10.0]		;ROUNDING UP MAY TAKE US OUT OF RANGE AGAIN
	 JRST FP4B1
	FDVRI T,(10.0)
	ADDI F,1		;ADJUST EXPONENT FOR THE DIVISION
]		;END OF IFE DBFLAG
;FOR DB$, JUST LET THE EXTRA INFO BITS SIT THERE, EVEN FOR SINGLE PRECISION!
; AFTER ALL, THE MASK HAS ALSO BEEN COMPUTED TO DOUBLE PRECISION
FP4B1:	PUSH FLP,F		;DON'T USE FXP!  WILL CONFLICT WITH MASK FOR DB$
	PUSHJ P,FP3		;NUMBER HAS BEEN NORMALIZED FOR  1.0 .LE. X < 10.0
DB$	CAILE B,33
DB$	 %D%			;FOR DOUBLE PRECISION, "D" INDICATES EXPONENT
DB$	CAIG B,33
	 %E%			;FOR SINGLE PRECISION, "E" INDICATES EXPONENT
	POP FLP,TT		;POP EXPONENT
	SKIPLE TT		;PRINT SIGN (BUT PRINT NO SIGN FOR 0)
	 %POS%
	SKIPGE TT
	 %NEG%
	MOVEI C,10.
	MOVMS TT
	JRST PRINI3		;PRINT EXPONENT AS A DECIMAL INTEGER
SUBTTL	PRINT A COMPLEX OR A DUPLEX

IFN CXFLAG,[
PRINCX:
IFN USELESS,[
	MOVEI T,35.
	SKIPN @-1(P)
	 MOVEI T,18.
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
	SKIPE T,@-1(P)		;DON'T PRINT REAL PART IF 0
	 PUSHJ P,FP0
KA	HRRZ A,-1(P)
KA	MOVE T,(A)
KA	MOVE TT,1(A)
KIKL	DMOVE T,@-1(P)
	JUMPE T,PRNCX2
	SKIPL TT
	 %POS%
PRNCX2:	JUMPE TT,PRNCX4
	SKIPGE TT
	 %NEG%
	MOVM T,TT
	PUSHJ P,FP0
PRNCX3:	MOVEI A,"J		;CROCK
	JRST (R)

PRNCX4:	MOVEI A,"0
	PUSHJ P,(R)
	JRST PRNCX3
]		;END OF IFN CXFLAG

IFN DXFLAG,[
PRINDX:
IFN USELESS,[
	MOVEI T,60.
	SKIPN @-1(P)
	 MOVEI T,30.
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
KA	HRRZ A,-1(P)
KA	MOVE T,(A)
KA	MOVE TT,1(A)
KIKL	DMOVE T,@-1(P)
	SKIPE T			;DON'T PRINT REAL PART IF 0
	 PUSHJ P,DFP0
	HRRZ A,-1(P)
KA	MOVE T,2(A)
KA	MOVE TT,3(A)
KIKL	DMOVE T,2(A)
	SKIPN @-1(P)
	 JRST PRNDX2
	SKIPL T
	 %POS%
PRNDX2:	JUMPE T,PRNCX4
	SKIPGE T
	 %NEG%
	JUMPGE T,PRNDX5
KA	DFN T,TT
KIKL	DMOVN T,T
PRNDX5:	PUSHJ P,DFP0
	JRST PRNCX3
]		;END OF IFN DXFLAG
IFN BIGNUM,[

SUBTTL	PRINT A BIGNUM

PRINB:
IFN USELESS,[
	HRRZ B,@-1(P)
	MOVEI T,1
PRINB0:	ADDI T,12.
	HRRZ B,(B)
	JUMPN B,PRINB0
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
	HRRZ A,-1(P)
	SKIPGE A,(A)
	JRST PRINBQ
IFE USELESS,	HRRZ D,@VBASE
IFN USELESS,[
	HRRZ D,VBASE
	CAIE D,QROMAN
	SKIPA D,(D)
	MOVEI D,10.
]		;END OF IFN USELESS
	CAILE D,10.
	 %POS%
	JRST PRINBZ
PRINBQ:	%NEG%		;NEGATIVE BIGNUM
PRINBZ:	MOVEM R,RSAVE
	HRRZM P,FSAVE	;STORE PDL POSITION SO AR1 AND AR2A CAN BE FOUND
	PUSH P,AR1
	PUSH P,AR2A
	PUSHJ P,YPOCB
	PUSH P,A
	PUSH P,[PRINB4]
	MOVE B,VBASE
IFN USELESS,[
	CAIN B,QROMAN
	SKIPA D,[10.]
]		;END OF IFN USELESS
	JSP T,FXNV2
	MOVE C,D
	JSP T,PRI.
	MOVE R,D
	MOVEI F,1
	MOVE T,D
PRBAB:	MUL T,D
	JUMPN T,.+4
	MOVE T,TT
	MOVE R,TT
	AOJA F,PRBAB
	MOVEM F,NORMF
	MOVE D,R
PRINB3:	MOVE C,A
	HLRZ B,(C)
	MOVE F,(B)
	MOVEI R,0
PNFBLP:	DIV R,D
	MOVEM R,(B)
	MOVE B,(C)
	TRNN B,-1
	JRST PRBFIN
	MOVE C,(C)
	MOVE R,F
	HLRZ B,(C)
	MOVE F,(B)
	JRST PNFBLP

PRBFNA:	HLR A,B
PRBFIN:	MOVS B,(A)
	TLNE B,-1
	SKIPE (B)
	JRST .+2
	JRST PRBFNA
	PUSH FXP,F
	MOVE R,(A)
	TRNN R,-1
	JRST PRBNUF
	PUSHJ P,PRINB3
PRINBI:	POP FXP,TT
	MOVE F,NORMF
	MOVE R,RSAVE
PRINBJ:	SETZ T,
	JSP D,PRINI5
	SOJE F,FP7A1
	MOVE TT,T
	PUSHJ P,PRINBJ
	JRST FP7A1

PRBNUF:	HLRZ A,R
	MOVE TT,(A)
	MOVE AR2A,FSAVE
	MOVE AR1,1(AR2A)	;RESTORE AR1 AND AR2A
	MOVE AR2A,2(AR2A)
	HRRZ C,VBASE
IFN USELESS,	CAIN C,QROMAN
IFN USELESS,	SKIPA R,[10.]
	JSP T,FXNV3
	MOVE C,R
	MOVE R,RSAVE
	SKIPE TT
	PUSHJ P,PRINI3
	JRST PRINBI

PRINB4:	POP P,A
	MOVEI B,TRUTH
	PUSHJ P,RECLAIM
	POP P,AR2A
	POP P,AR1
	POPJ P,
]		;END OF IFN BIGNUM
SUBTTL	FLATSIZE, FLATC, EXPLODEC, EXPLODEN, EXPLODE

FLATSIZE:
	PUSH P,CFIX1		;SUBR 1
	SKIPA R,CFLAT2		;POPJ IS POSITIVE
FLAT4:	 HRROI R,FLAT2
FLAT3:	SETZM FLAT1
	PUSHJ P,PRINTF
	SKIPA TT,FLAT1
FLAT2:	 AOS FLAT1
CFLAT2:	POPJ P,FLAT2

FLATC:	PUSH P,CFIX1		;SUBR 1
	JSP T,SPATOM
	 JRST FLAT4
	JUMPN A,FLATC1
	MOVEI TT,3		;FLATC OF NIL IS 3
	POPJ P,

FLATC1:	HLRZ TT,(A)		;FAST-FLATC FOR SYMBOLS
	HRRZ A,1(TT)
	SETZ TT,
FLATC2:	HRRZ B,(A)		;COUNT 5 CHARS PER PNAME WORD
	ADDI TT,BYTSWD
	JUMPE B,FLATC3
	HRRZ A,(B)
	ADDI TT,BYTSWD
	JUMPN A,FLATC2
	MOVEI A,(B)
FLATC3:	HLRZ A,(A)		;LAST PNAME WORD MAY BE PARTIAL
	SKIPN T,(A)		;WATCH OUT FOR NULL PNAME!
	 SUBI TT,1
	TRNE T,177←1
	 POPJ P,
	TRNE T,177←10
	 SOJA TT,CPOPJ
	SUBI TT,3
	TDNE T,[177←17]
	 AOJA TT,CPOPJ
	TLNN T,(177←26)
	 SUBI TT,1
	POPJ P,

$EXPLODEC:
	SKIPA R,EXPLODE		;SUBR 1	;HRRZI IS NEGATIVE!!!
$$EXPLODEN:
	HRROI R,EXPL2		;SUBR 1
	SKOTT A,SY
	JRST EXPL4
	HLRZ T,(A)
	HRRZ A,1(T)
	PUSH P,R70		;FORMING LIST OF CHARS
	MOVEI B,(P)
	PUSH P,A
	PUSH P,B
	XOR R,EXPLODE
	PUSH FXP,R
EXPLY1:	SKIPN A,-1(P)
	JRST EXPLY9
	HLRZ B,(A)
	MOVE D,(B)
	HRRZ A,(A)
	MOVEM A,-1(P)
EXPLY2:	JUMPE D,EXPLY1
	SETZ TT,
	LSHC TT,7
	SKIPE (FXP)
	JRST EXPLY3
	PUSH FXP,D
	PUSHJ P,RDCH2
	POP FXP,D
	JRST EXPLY4
EXPLY3:	MOVEI A,IN0(TT)		.SEE HINUM
EXPLY4:	PUSHJ P,NCONS
	HRRM A,@(P)
	HRRZM A,(P)
	JRST EXPLY2

EXPLY9:	SUB P,R70+2
	SUB FXP,R70+1
	JRST POPAJ
EXPLODE: HRRZI R,EXPL1		;SUBR 1
EXPL4:	PUSH P,R70
	HRRZM P,EXPL5
	PUSHJ P,PRINTF
	JRST POPAJ

EXPL1:	SAVE B C
	SAVEFX TT R
	ANDI A,177
	PUSHJ P,RDCH3
	POP P,C
EXPL3:	PUSHJ P,NCONS
	HRRM A,@EXPL5
	HRRZM A,EXPL5
EXPL6:	RSTRFX R TT
	JRST POPBJ

EXPL2:	PUSH P,B
	SAVEFX TT R
	MOVEI A,IN0(A)
	JRST EXPL3

SUBTTL	BAKTRACE

BAKTRACE:			;PRINT A BAKTRACE
	JSP TT,LWNACK
	LA03,,QBAKTRACE
	MOVNI TT,1
	JRST BKTR0
BAKLIST:			;RETURN A LIST (SIMILAR TO PRINTED FORMAT)
	JSP TT,LWNACK
	LA01,,QBAKLIST
	MOVSI TT,400000
BKTR0:	MOVEM TT,BACTYF		;TYPE FLAG FOR BAKTRACE/BAKLIST
	MOVEI A,NIL		;START WITH NIL
	SKIPE T			;OR USER SUPPLIED ARG
	 POP P,A
	JSP R,GTPDLP		;GET APPROPRIATE PDL POINTER
		0
	 JFCL
	MOVEI A,(D)		;SAVE PDL POINTER IN A
	MOVE B,(A)		;GET TOP OF STACK
	CAME B,[QBAKTRACE,,CPOPJ]
	 CAMN B,[QBAKLIST,,CPOPJ]
	  SOS A			;SKIP FIRST SLOT IF CALL TO US
	MOVEI R,60		;LOOK AT ABOUT 60 STACK LOCATIONS
	HRRZ TT,C2		;GET PDL ORIGION
	SUBM A,TT		;SAVE PDL OFFSET IN TT
	CAIG TT,(R)		;FEWER THAN 60 LOCATIONS TO LOOK AT?
	 MOVE R,TT		;YES, SO LOOK AT THAT MANY
	MOVE T,A
	SETZM CPJSW		;ASSUME *RSET HAS BEEN OFF
	MOVEI B,CPOPJ
BKTR3:	MOVE TT,(T)		;CUT OUT STUFF FROM *RSET LOOP, IF USED
	CAIN B,(TT)
	 TLNN TT,-1
	  SKIPA
	   SETOM CPJSW		;APPARENTLY *RSET HAS BEEN ON
	TLZ TT,-1#10000
	CAMN TT,[10000,,LSPRET]
	 MOVEI A,-1(T)
	SOS T
	SOJG R,BKTR3
	MOVEM A,BKTRP		;SET UP FOR BAKTRACE LOOP AND GO THERE
	MOVE A,BACTYF
	AOJE A,BKTR2		;IF TRACING THEN SKIP LIST HACKING STUFF
	PUSH P,R70		;SET UP LIST TO HOLD BAKLISTING
	HRLM P,(P)		;SET UP LAST-OF-LIST POINTER
BKTR2:	HRRZ A,C2		;THE PDL-HUNTING LOOP
	ADDI A,1
	CAML A,BKTRP
	 JRST BKTR2X		;EXIT WHEN BACKED UP TO BOTTOM OF PDL
	AOSN BACTYF
	 STRT [SIXBIT \↑MBAKTRACE↑M!\]
	HRRZ A,@BKTRP
	CAIN A,CPOPJ		;IN *RSET MODE, THIS IS A TAG
	 JRST BKTR1C		;PUT ON PDL UPON ENTRY TO A FUNCTION
	CAIN A,ILIST3
	 JRST BKTR1B
	MOVE D,@BKTRP
	TLNE D,10000#-1		;TO BE A PUSHJ RETURN ADDR, THERE MUST 
	 CAIN A,BKCOM1		; BE PC FLAGS IN LH
	  JRST BKTR1
	CAIL A,BEGFUN
	 CAIL A,ENDFUN
	  JRST BKTR1A
	CAIE A,CON2
	 CAIN A,CON3
	  JRST BKTR1G
	CAIN A,PG0A
	 JRST BKTR1E
	CAIN A,LMBLP1
	 JRST BKTR1
	CAILE A,BRLP1
	 CAILE A,BRLP2
	  SKIPA
	   JRST BKTR1H
Q%	CAIN A,RDIN3B
Q%	 JRST BKTRR5
Q%	CAIE A,RDIN3A
	 CAIN A,REKRD1
	  JRST BKTRR3
	CAIE A,UNBIND
	 JRST BKTR1A
BKTR1:	SOS BKTRP
	JRST BKTR2
BKTR2X:	AOSE BACTYF
	 SKIPL BACTYF
	  JRST TERPRI
	POP P,A
	JRST RHAPJ
BKTR1A:	CAMGE A,@VBPORG		;LETS HOPE THAT BPORG ISN'T SCREWED UP
	 CAIGE A,BBPSSG
	  JRST BKTR1
BK1A2:	MOVEI AR1,-1(A)
BK1A4:	HLRZ B,-1(A)		;SOMEWHERE IN BINARY PROGRAMS
	MOVEI R,PRIN1B		;IF "CALL", THEN SUBR ATOM NAME WILL BE IN B
	TRC B,37		;LIKELY NOT AN INSTRUCTION IF ALL THE INDIRECT,
	TRCE B,37		; AND INDEXING BITS ARE ONES
	 CAIGE B,(CALL )
	  JRST BKTR1
	CAIG B,(JCALLF 17,)
	 JRST BK1A1
	CAIE B,(XCT)		;MIGHT BE A XCT OF A CALL, JRST, PUSHJ TO SUBR
	 JRST .+3
	   HRRZ A,-1(A)		;IF SO, CYCLE TO TRY TO FIND CALLED SUBR NAME
	   AOJA A,BK1A4
	MOVEI R,ERRADR		;HA! MAYBE  PUSHJ OR JRST, SO NOW WE HAVE 
	CAIN B,(JRST 0,)	; ONLY BEGINNING ADDRESS OF SUBR.  HENCE
	 JRST BK1A1		; IT HAS TO BE DECODED INTO ATOM NAME.
	CAIE B,(PUSHJ P,)
	 JRST BKTR1		;LOSE, DON'T KNOW WHAT KIND OF INST THIS IS
	HLLZ B,@BKTRP
	TLNN B,10000		;USER MODE FLAG - STOPS RANDOM
	 JRST BKTR1		; DATA NOT ENTERED BY PUSHJ

BK1A1:	MOVE B,-1(A)		;EITHER "(J)CALL(F)", "JRST", OR "PUSHJ P,"
	TLNE B,7777760		;LET INDIRECTION HAPPEN, BUT CAN'T CHANCE 
	 TLNE B,((17))		;  DOING IT IF THE UUO IS INDEXED, OR 
	  JRST BK1A1B		;  ADDRESSES AN AC
	MOVEI B,@-1(A)		;LET INDIRECT DO ITS THING
BK1A1C:	PUSH P,AR1		;ORIGINAL PC WHEREFROM SUBR WAS CALLED
	SKIPGE BACTYF
	 JRST BK1A3
	PUSHJ P,(R)		;R HAS EITHER PRIN1B OR ERRADR
	STRT [SIXBIT \←!\]	;  DEPENDING ON WHETHER "CALL" OR "PUSHJ P,"
	POP P,B
	PUSHJ P,ERRADR
	STRT [SIXBIT \ !\]
	JRST BKTR1

BK1A3:	CAIE R,ERRADR
	 SKIPA A,B
	  PUSHJ P,ERRDCD	;"ERRDCD" DECODES ADDRESS IN B, GETS ATOM IN A
	EXCH A,(P)
	PUSHJ P,ERRDCD
	PUSH P,[QLA]
	PUSH P,A
	MOVNI T,3
	JRST BKT1F2

BK1A1B:	CAIN R,ERRADR
	 TDZA B,B
	  MOVEI B,QM
	JRST BK1A1C
BKTR1B:	MOVE D,BKTRP
	HRRZ B,-1(D)	;PROBABLY FOR ENTRY TO SOME SUBR, LSUBR, OR EXPR
	CAIE B,ELSB1	;LISTING TINGS UP ON THE PDL
	 CAIN B,ESB1
	  JRST .+3
	CAIE B,IAPPLY
	 JRST BKTR1
	HLRE B,-1(D)
	ADDI B,-3(D)
	HLRZ A,(B)
	JUMPE A,BKTR1
	HRRZM B,BKTRP
	SKIPGE BACTYF
	 JRST BKT1B1
	STRT [SIXBIT \(!\]
	PUSHJ P,PRINC
	STRT [SIXBIT \ EVALARGS) !\]
	JRST BKTR1

BKTR1C:	HLRZ A,@BKTRP	;PROBABLY ENTERED AN F-TYPE FUNCTION
	JUMPE A,BKTR1	;WELL, NIL ISN'T REALLY A FUNCTION
BKTR1F:	SKIPGE BACTYF
	JRST BKT1F1
	PUSHJ P,PRINC
	STRT [SIXBIT \← !\]
	JRST BKTR1

BKT1B1:	SKIPA B,[QEVALARGS]
BKT1F1:	 MOVEI B,QLA
	PUSH P,A
	PUSH P,B
	MOVNI T,2
BKT1F2:	PUSHJ FXP,LISTX
	PUSHJ P,NCONS
	HLRZ B,(P)
	HRRM A,(B)	;NCONC MOST RECENT GOODIE ONTO END OF LIST
	HRLM A,(P)	;UPDATE LAST-OF-LIST POINTER
	JRST BKTR1

BKTR1H:	MOVNI T,LERSTP+5-1	;2 FROM BREAK, 2 FROM EDERRL, 1 FROM BRLP = 5
	MOVEI A,QBREAK		;-1 SINCE BKTR1 WILL TAKE OFF ONE MORE
	JRST BKTR1D
BKTR1E:	MOVNI T,LPRP		;BACK UP OFF A PROG
	MOVEI A,QPROG
BKTR1D:	ADDM T,BKTRP
	JRST BKTR1I

BKTR1G:	MOVEI A,QCOND		;FOUND A COND ENTRY
BKTR1I:	SKIPE CPJSW
	 JRST BKTR1		;IF *RSET WAS ON, ENTRY IS BE MARKED BY CPOPJ
	JRST BKTR1F

BKTRR3:	SKIPA T,XC-3
BKTRR5:	 MOVNI T,5
	ADDM T,BKTRP
	JRST BKTR1


PGTOP PRT,[PRINT,TYO,EXPLODE,FLATC,BAKTRACE,ETC]